home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 4 NO 4.st / APPROACH.ARC / APPROACH.GFA (.txt) next >
Encoding:
GFA-BASIC Atari  |  1989-08-14  |  57.6 KB  |  2,002 lines
  1. '
  2. ' ***********************************
  3. ' *** "FINAL APPROACH CONTROLLER" ***
  4. ' *** AN AIR TRAFFIC CONTROL GAME ***
  5. ' *** & TITLE SONG "BEACON BEATS" ***
  6. ' ***       BY KEVIN MASON        ***
  7. ' *** * * * * * * * * * * * * * * ***
  8. ' ***  WRITTEN IN GFA BASIC 3.0   ***
  9. ' ***        Version 1.2          ***
  10. ' * COPYRIGHT 1989 ANTIC PUBLISHING *
  11. ' ***********************************
  12. '
  13. CLEAR
  14. GOSUB inits
  15. ON ERROR GOSUB err_handler
  16. '
  17. DO
  18.   ON MENU 100
  19.   IF SUB(TIMER,elapsed_time%)>200  !'EVERY 200 GOSUB PAINTSCREEN' DOESN'T WORK
  20.     GOSUB paint_screens
  21.   ENDIF
  22. LOOP
  23. '
  24. ' *** DRAW MAIN GRAPHICS EVERY 1 SECOND ***
  25. '
  26. PROCEDURE paint_screens
  27.   elapsed_time%=TIMER
  28.   line4$=TIME$
  29.   HIDEM
  30.   VOID XBIOS(5,L:logbase1_adr%,L:-1,-1)
  31.   ~C:asmmove1_adr%(L:grid_adr%,L:logbase1_adr%)!AS FAST AS SPUT$
  32.   IF begin_storm! OR storm! OR storm_over!           !OH! OH! THUNDERSTORMS!!!
  33.     ~C:asmput_adr%(L:logbase1_adr%,L:storm_adr%(sf1%),tsx%(1),tsy%(1),w%,h%,sm%)
  34.     ~C:asmput_adr%(L:logbase1_adr%,L:storm_adr%(sf2%),tsx%(2),tsy%(2),w%,h%,sm%)
  35.   ENDIF
  36.   FOR i%=1 TO 12                              !TRAFFIC LIST
  37.     IF BTST(lr|(i%),0)                        !AIRCRAFT ACTIVE?
  38.       line1$=trafname$(i%)
  39.       line2$=arvdest$(i%)
  40.       ~C:asmtxt_adr%(L:*line1$,282,trafnamey%(i%))
  41.       ~C:asmtxt_adr%(L:*line2$,282,arvdesty%(i%))
  42.       IF BTST(lr|(i%),1)                      !AIRCRAFT INFLIGHT?
  43.         at%=C:which_bit%(ca|(i%))             !WHICH ALTITUDE BIT IS TURNED ON?
  44.         ht%=C:which_bit%(ch|(i%))             !WHICH HEADING BIT IS TURNED ON?
  45.         line3$=" "+STR$(at%)+vor$(i%)+heading$(ht%)
  46.         ~C:asmtxt_adr%(L:*line1$,acx%(i%),SUB(acy%(i%),12)) !AIRCRAFT ID
  47.         ~C:asmtxt_adr%(L:*line3$,acx%(i%),SUB(acy%(i%),6))  !ALTITUDE - HEADING
  48.         ~C:asmtxt_adr%(L:*point$,acx%(i%),acy%(i%))         !POINTER
  49.       ENDIF
  50.     ENDIF
  51.   NEXT i%
  52.   ~C:asmmove2_adr%(L:overlay_adr%,L:logbase1_adr%) !FASTER THAN PUT, MODE 6
  53.   DEFTEXT 1,0,0,4
  54.   ~C:asmtxt_adr%(L:*line4$,6,9)
  55.   VOID XBIOS(5,L:-1,L:logbase1_adr%,-1) !SO WE CAN SEE MOUSE and NEW DRAWN SCRN
  56.   SWAP logbase1_adr%,logbase2_adr%    !SWITCH TO LOG2 SCREEN FOR HIDDEN DRAWING
  57.   SHOWM
  58.   DEFTEXT 0,0,0,4
  59.   '
  60.   IF all_activated!=FALSE       !ANY AIRCRAFT LEFT TO SELECT FROM?
  61.     GOSUB add_traffic           !TIME TO ADD ANOTHER AIRCRAFT
  62.   ENDIF
  63.   '
  64.   no_more_planes!=TRUE
  65.   FOR i%=1 TO 12
  66.     IF BTST(lr|(i%),1)          !AIRCRAFT IS ACTIVE INFLIGHT
  67.       GOSUB do_speed_check(i%)  !MOVEMENT ROUTINES
  68.       GOSUB location(i%)        !LOCATION DETECTION ROUTINES
  69.       no_more_planes!=FALSE     !AT LEAST ONE AIRCRAFT IS ACTIVE
  70.     ENDIF
  71.   NEXT i%
  72.   '
  73.   GOSUB near_miss               !NEAR MISS, COLLISION ROUTINES
  74.   '
  75.   GOSUB boolean_tests           !OTHER IRREGULAR ROTUINES
  76.   '
  77. RETURN
  78. '
  79. ' ***********************
  80. ' *** MAIN LOOP CALLS ***
  81. ' ***********************
  82. '
  83. ' *** MULTIPLE BOOLEAN TESTS ***
  84. '
  85. PROCEDURE boolean_tests
  86.   '
  87.   IF VAL(MID$(TIME$,4,2))=begin_storm%  !RANDOM STORM GENERATOR
  88.     begin_storm!=TRUE
  89.     begin_storm%=0
  90.   ENDIF
  91.   IF begin_storm!=TRUE                  !STORM BUILD UP SEQUENCE
  92.     GOSUB storm_begin
  93.   ENDIF
  94.   IF storm!=TRUE                        !STORM ROLLS ACROSS THE PRAIRIE
  95.     GOSUB storm
  96.   ENDIF
  97.   IF storm_over!=TRUE                   !STORM DYING DOWN SEQUENCE
  98.     GOSUB storm_over
  99.   ENDIF
  100.   '
  101.   IF alert!=TRUE
  102.     GOSUB blink_alert                   !SOUND ALARM
  103.   ENDIF
  104.   '
  105.   IF begin_storm!=TRUE OR storm!=TRUE OR storm_over!=TRUE
  106.     GOSUB move_storm                    !THUNDERSTORMS ON THE PROWL
  107.   ENDIF
  108.   '
  109.   IF start!=TRUE
  110.     GOSUB start_game
  111.   ENDIF
  112.   '
  113.   IF all_activated!=TRUE AND no_more_planes!=TRUE
  114.     GOSUB all_done  !ALL 36 AIRCRAFT ACTIVATED, BUT NONE LEFT FLYING, GAME OVER
  115.   ENDIF
  116.   '
  117. RETURN
  118. '
  119. ' *** START GAME ***
  120. '
  121. PROCEDURE start_game
  122.   VOID XBIOS(6,L:colrscr2_adr%)  !LOAD COLOR PALETTE #2
  123.   counter%=game_speed%
  124.   GOSUB add_traffic
  125.   start!=FALSE
  126. RETURN
  127. '
  128. ' *** BLINKING ALERT LIGHTS ***
  129. '
  130. PROCEDURE blink_alert
  131.   IF alert!
  132.     VOID XBIOS(32,L:alert_snd_adr%)       !START VBI SOUND
  133.     VOID XBIOS(7,8,red%)
  134.     PAUSE 2
  135.     VOID XBIOS(7,8,mgray%)
  136.     alert!=FALSE            !STOP FLASHING
  137.   ENDIF
  138. RETURN
  139. '
  140. ' *** ERROR HANDLER ***
  141. '
  142. PROCEDURE err_handler
  143.   er%=ERR
  144.   VOID FORM_ALERT(1,ERR$(er%))
  145.   RESUME NEXT
  146. RETURN
  147. '
  148. ' ********* MANAGE NEW TRAFFIC ROUTINES *********
  149. '
  150. ' *** TIME TO ADD A NEW PLANE TO TRAFFIC LIST ***
  151. '
  152. PROCEDURE add_traffic
  153.   INC counter%
  154.   IF counter%>=game_speed%+RANDOM(game_speed_var%) !20% VARIABILITY
  155.     counter%=0
  156.     i%=0
  157.     DO                                  !CHECK ALL 12 TRAFFIC LIST SLOTS
  158.       INC i%
  159.       IF i%>12                          !ERROR TRAP
  160.         i%=12
  161.         GOTO jump_loop
  162.       ENDIF
  163.       IF MID$(trafname$(i%),2,1)=" "    !FIND FIRST VACANT SPOT ON TRAFFIC LIST
  164.         jr%=RANDOM(total_ac%-ac_count%) !SELECT RANDOM# BETWEEN 0 AND AC# LEFT
  165.         IF jr%<0 OR jr%>(total_ac%-ac_count%-1)
  166.           i%=12                         !ERROR TRAP
  167.           GOTO jump_loop
  168.         ENDIF
  169.         trafname$(i%)=ac$(jr%)          !GET AIRCRAFT IDENTIFICATION #
  170.         DELETE ac$(jr%)                 !DELETE FROM AIRCRAFT LIST
  171.         INC ac_count%                   !KEEP COUNT OF AIRCRAFT ADDED
  172.         IF ac_count%>=36                !GAME NEARLY OVER, HANDLED 36 AIRCRAFT
  173.           all_activated!=TRUE
  174.         ENDIF
  175.         '
  176.         SELECT ASC(MID$(trafname$(i%),2,1)) !GET AIRCRAFT LETTER DESIGNATION
  177.         CASE 70                       !ITS "F"
  178.           lr|(i%)=BSET(lr|(i%),2)     !AIRCRAFT IS F-15, SET SPEED BIT
  179.         CASE 84                       !ITS "T"
  180.           lr|(i%)=BSET(lr|(i%),3)     !AIRCRAFT IS T-37, SET SPEED BIT
  181.         CASE 65                       !IT "A"
  182.           lr|(i%)=BSET(lr|(i%),4)     !AIRCRAFT IS UH-1H, SET SPEED BIT
  183.         DEFAULT                       !ERROR TRAP
  184.           lr|(i%)=BSET(lr|(i%),3)
  185.           acspeed!=TRUE
  186.         ENDSELECT
  187.         GOSUB activate_ac(i%)
  188.         '
  189.         jr2%=RANDOM(37)               !RANDOMLY GET NUMBER 0 to 36
  190.         IF jr2%<0 OR jr2%>36          !ERROR TRAP
  191.           jr2%=1
  192.         ENDIF
  193.         arvdest$(i%)=ad$(jr2%)        !GET FROM ARRIVAL-DESTINATION LIST
  194.         IF MID$(arvdest$(i%),1,2)="DN"
  195.           GOSUB place_inflight(i%,1,4)         !FROM DNV, GOING SE
  196.         ELSE IF MID$(arvdest$(i%),1,2)="OK"
  197.           GOSUB place_inflight(i%,2,2)         !FROM OKC, GOING SW
  198.         ELSE IF MID$(arvdest$(i%),1,2)="AD"
  199.           GOSUB place_inflight(i%,3,1)         !FROM ADA, GOING W
  200.         ELSE IF MID$(arvdest$(i%),1,2)="DF"
  201.           GOSUB place_inflight(i%,4,0)         !FROM DFW, GOING NW
  202.         ELSE IF MID$(arvdest$(i%),1,2)="LU"
  203.           GOSUB place_inflight(i%,5,6)         !FROM LUB, GOING NE
  204.         ELSE IF MID$(arvdest$(i%),1,2)="AM"
  205.           GOSUB place_inflight(i%,6,4)         !FROM AMR, GOING SE
  206.         ELSE IF MID$(arvdest$(i%),1,2)="FS"
  207.           GOSUB ready_takeoff(i%)
  208.         ELSE IF MID$(arvdest$(i%),1,2)="LA"
  209.           GOSUB ready_takeoff(i%)
  210.         ENDIF
  211.         i%=12
  212.       ENDIF
  213.     jump_loop:
  214.     LOOP UNTIL i%=12
  215.   ENDIF
  216. RETURN
  217. '
  218. ' *** ACTIVATE AIRCRAFT ***
  219. '
  220. PROCEDURE activate_ac(acn%)
  221.   mc|(acn%)=BSET(mc|(acn%),1) !SET MOVEMENT COUNTER TO MOVEMENT #1
  222.   sp|(acn%)=BSET(sp|(acn%),1) !SET SPEED COUNTER TO RESET
  223.   lr|(acn%)=BSET(lr|(acn%),0) !SET AIRCRAFT ACTIVE BIT
  224. RETURN
  225. '
  226. ' *** PLACE AIRCRAFT INFLIGHT ***
  227. '
  228. PROCEDURE place_inflight(acn%,entry%,dir%)
  229.   lr|(acn%)=BSET(lr|(acn%),1)              !SET INFLIGHT BIT 'ON'
  230.   ch|(acn%)=0                              !CLEAR BYTE
  231.   ch|(acn%)=BSET(ch|(acn%),dir%)           !SET CURRENT HEADING
  232.   dh|(acn%)=0                              !CLEAR BYTE
  233.   dh|(acn%)=BSET(dh|(acn%),dir%)           !SET DESIRED HEADING
  234.   vor|(acn%)=0                             !SET VOR HOLD OFF
  235.   vor$(acn%)=" "                           !NO 'v' ON RADAR ICON
  236.   acx%(acn%)=entryx%(entry%)               !SET ENTRY X,Y POSITION
  237.   acy%(acn%)=entryy%(entry%)
  238. RETURN
  239. '
  240. ' *** PLACE AIRCRAFT AT AIRFIELD AWAITING TAKEOFF COMMAND ***
  241. '
  242. PROCEDURE ready_takeoff(acn%)
  243.   ca|(acn%)=0                      !CLEAR BYTE
  244.   ca|(acn%)=BSET(ca|(acn%),0)      !SET ALTITUDE TO ZERO, AND
  245.   da|(acn%)=0                      !CLEAR BYTE
  246.   da|(acn%)=BSET(da|(acn%),0)      !AWAIT TAKEOFF COMMAND
  247.   vor|(acn%)=0                     !SET VOR HOLD OFF
  248.   vor$(acn%)=" "                   !NO 'v' ON RADAR ICON
  249. RETURN
  250. '
  251. ' ******* MOVEMENT CALCULATIONS *******
  252. '
  253. ' *** DETERMINE SPEED ***
  254. '
  255. PROCEDURE do_speed_check(ac%)
  256.   speed%=lr|(ac%) AND &X11100      !MASK OUT SPEED BITS
  257.   speed%=C:which_bit%(speed%)      !WHICH SPEED BIT IS SET?
  258.   IF BTST(sp|(ac%),speed%)         !CHECK SPEED
  259.     GOSUB do_move_head_alt         !TIME TO MOVE
  260.     sp|(ac%)=BCLR(sp|(ac%),speed%) !CLEAR SPEED COUNTER
  261.     sp|(ac%)=BSET(sp|(ac%),1)      !RESET SPEED COUNTER TO BIT #1 (RESET)
  262.   ELSE
  263.     sp|(ac%)=SHL(sp|(ac%),1)       !INC SPEED COUNTER, DO NOT MOVE YET
  264.   ENDIF
  265. RETURN
  266. '
  267. ' *** CHECK MOVE NUMBER, ADJUST HEADING AND ALTITUDE
  268. '
  269. PROCEDURE do_move_head_alt
  270.   IF BTST(mc|(ac%),5)          !CHECK HEADING-ALTITUDE EVERY FIFTH MOVE
  271.     GOSUB move_plane
  272.     GOSUB heading_altitude     !CALCULATE NEW HEADING/ALT FOR NEXT 5 MOVES
  273.     mc|(ac%)=BCLR(mc|(ac%),5)  !CLEAR MOVEMENT #5
  274.     mc|(ac%)=BSET(mc|(ac%),1)  !RESET TO MOVEMENT #1
  275.   ELSE
  276.     GOSUB move_plane
  277.     mc|(ac%)=SHL|(mc|(ac%),1)  !INC COUNTER TO NEXT MOVEMENT
  278.   ENDIF
  279. RETURN
  280. '
  281. ' *** MOVE AIRCRAFT RADAR TARGET ***
  282. '
  283. PROCEDURE move_plane
  284.   SELECT ch|(ac%)   !CALC NEW X,Y COORDINATES AND LIMIT TO BOUNDARIES
  285.   CASE 128
  286.     SUB acy%(ac%),MUL(ABS(acy%(ac%)>nb%),2) !NORTH
  287.   CASE 64
  288.     SUB acy%(ac%),MUL(ABS(acy%(ac%)>nb%),2) !NORTHEAST
  289.     ADD acx%(ac%),MUL(ABS(acx%(ac%)<eb%),2)
  290.   CASE 32
  291.     ADD acx%(ac%),MUL(ABS(acx%(ac%)<eb%),2) !EAST
  292.   CASE 16
  293.     ADD acy%(ac%),MUL(ABS(acy%(ac%)<sb%),2) !SOUTHEAST
  294.     ADD acx%(ac%),MUL(ABS(acx%(ac%)<eb%),2)
  295.   CASE 8
  296.     ADD acy%(ac%),MUL(ABS(acy%(ac%)<sb%),2) !SOUTH
  297.   CASE 4
  298.     ADD acy%(ac%),MUL(ABS(acy%(ac%)<sb%),2) !SOUTHWEST
  299.     SUB acx%(ac%),MUL(ABS(acx%(ac%)>wb%),2)
  300.   CASE 2
  301.     SUB acx%(ac%),MUL(ABS(acx%(ac%)>wb%),2) !WEST
  302.   CASE 1
  303.     SUB acx%(ac%),MUL(ABS(acy%(ac%)>nb%),2) !NORTHWEST
  304.     SUB acy%(ac%),MUL(ABS(acx%(ac%)>wb%),2)
  305.   ENDSELECT
  306. RETURN
  307. '
  308. ' *** CALCULATE NEW HEADING AND ALTITUDE ***
  309. '
  310. PROCEDURE heading_altitude
  311.   '
  312.   IF BTST(vor|(ac%),0)             !IF VOR HOLD ACTIVATED
  313.     IF BTST(vor|(ac%),3)           !IS LEFT TURN VOR HOLD ACTIVATED?
  314.       lr|(ac%)=BSET(lr|(ac%),7)    !LEFT TURN BIT ON
  315.       lr|(ac%)=BCLR(lr|(ac%),6)    !RIGHT TURN BIT OFF
  316.       dh|(ac%)=ROL|(dh|(ac%),1)    !INC DESIRED HEADING BY 45 DEGREES LEFT
  317.     ENDIF
  318.     IF BTST(vor|(ac%),4)           !IS RIGHT TURN VOR HOLD ACTIVATED?
  319.       lr|(ac%)=BSET(lr|(ac%),6)    !RIGHT TURN BIT ON
  320.       lr|(ac%)=BCLR(lr|(ac%),7)    !LEFT TURN BIT OFF
  321.       dh|(ac%)=ROR|(dh|(ac%),1)    !INC DESIRED HEADING BY 45 DEGREES RIGHT
  322.     ENDIF
  323.   ENDIF
  324.   '
  325.   IF ch|(ac%) AND dh|(ac%)    !CURRENT HEADING = DESIRED HEADING
  326.   ELSE IF BTST(lr|(ac%),7)    !NEED NEW CURRENT HEADING
  327.     ch|(ac%)=ROL|(ch|(ac%),1) !INC HEADING BY 45 DEGREES LEFT
  328.   ELSE
  329.     ch|(ac%)=ROR|(ch|(ac%),1) !INC HEADING BY 45 DEGREES RIGHT
  330.   ENDIF
  331.   '
  332.   IF ca|(ac%) AND da|(ac%)    !CURRENT ALTITUDE = DESIRED ALTITUDE
  333.   ELSE IF ca|(ac%)<da|(ac%)   !CURRENT ALTITUDE BELOW DESIRED ALTITUDE
  334.     ca|(ac%)=SHL|(ca|(ac%),-(ca|(ac%)<128)) !INC ALT BY 1000', BUT NOT>7000'
  335.   ELSE                        !CURRENT ALTITUDE ABOVE DESIRED ALTITUDE
  336.     ca|(ac%)=SHR|(ca|(ac%),-(ca|(ac%)>0))   !DEC ALT BY 1000', BUT NOT<0
  337.   ENDIF
  338. RETURN
  339. '
  340. ' *** STORM BUILD UP SEQUENCE ***
  341. '
  342. PROCEDURE storm_begin
  343.   IF sf1%=9
  344.     storm!=TRUE
  345.     begin_storm!=FALSE
  346.     sf1%=1
  347.     sf2%=4
  348.   ENDIF
  349.   DEC sf1%
  350.   DEC sf2%
  351. RETURN
  352. '
  353. ' *** STORM SEQUENCE ***
  354. '
  355. PROCEDURE storm
  356.   IF sf1%=8
  357.     sf1%=1              !RESET STORM FROM NUMBER TO 1 AFTER 8 FRAMES SEEN
  358.   ENDIF
  359.   IF sf2%=8
  360.     sf2%=1              !RESET STORM FROM NUMBER TO 1 AFTER 8 FRAMES SEEN
  361.   ENDIF
  362.   INC sf1%
  363.   INC sf2%
  364. RETURN
  365. '
  366. ' *** STORM DYING DOWN SEQUENCE ***
  367. '
  368. PROCEDURE storm_over
  369.   IF sf1%=16            !STORM DYING DOWN SEQUENCE
  370.     storm_over!=FALSE
  371.     sf1%=15
  372.     sf2%=15
  373.   ENDIF
  374.   INC sf1%
  375.   INC sf2%
  376. RETURN
  377. '
  378. ' *** CALCULATE NEW THUNDERSTORM CLOUDS POSITIONS ***
  379. '
  380. PROCEDURE move_storm
  381.   IF storm_counter%=12       !STORMS MOVE AT 60 KNOTS
  382.     FOR i%=1 TO 2            !MOVE STORMS NORTHEASTERLY
  383.       SUB tsy%(i%),MUL(ABS(tsy%(i%)>nb%),2)
  384.       ADD tsx%(i%),MUL(ABS(tsx%(i%)<eb%),2)
  385.       IF change_course%=7     !GIVE SOME SOUTHERLY DRIFT TO THE THUNDERSTORMS
  386.         FOR j%=1 TO 2
  387.           INC tsy%(j%)
  388.           INC tsx%(j%)
  389.         NEXT j%
  390.         change_course%=1
  391.       ENDIF
  392.       INC change_course%          !STORM DRIFT COUNTER
  393.     NEXT i%
  394.   ENDIF
  395.   INC storm_counter%              !STORM MOVEMENT COUNTER
  396.   IF storm_counter%=13
  397.     storm_counter%=1
  398.   ENDIF
  399.   IF tsx%(1)>124 AND tsx%(1)<128  !STORM OVER
  400.     storm!=FALSE
  401.     storm_over!=TRUE
  402.     IF begin_storm%=0             !BEGIN STORM DISSIPATION SEQUENCE
  403.       sf1%=9                      !SET STORM ANIMATION FRAMES TO #9
  404.       sf2%=9
  405.       begin_storm%=-1
  406.     ENDIF
  407.   ENDIF
  408. RETURN
  409. '
  410. ' ******* CHECK LOCATION ROUTINES *******
  411. '
  412. ' *** CHECK AIRCRAFT LOCATION ***
  413. '
  414. PROCEDURE location(ac%)
  415.   '
  416.   ' * OUT OF BOUNDS CHECK
  417.   IF (PTST(acx%(ac%),acy%(ac%))=8 OR PTST(acx%(ac%),acy%(ac%))=2) AND BTST(ca|(ac%),7)=FALSE
  418.     '  !OUT OF BOUNDS and NOT AT 7,000'
  419.     alert!=TRUE
  420.     INC err_or%
  421.     GOSUB reset_ac
  422.   ENDIF
  423.   IF BTST(ca|(ac%),7)  !STILL AT 7,000' and OUT OF BOUNDS
  424.     IF (acx%(ac%)<10 OR acx%(ac%)>230) OR (acy%(ac%)<10 OR acy%(ac%)>185)
  425.       alert!=TRUE
  426.       INC err_or%
  427.       GOSUB reset_ac
  428.     ENDIF
  429.   ENDIF
  430.   '
  431.   ' * WANDERED INTO RESTRICTED AREA?
  432.   IF acy%(ac%)>70 AND acy%(ac%)<86
  433.     IF (acx%(ac%)>54 AND acx%(ac%)<110) OR (acx%(ac%)>120 AND acx%(ac%)<160)
  434.       alert!=TRUE
  435.       INC err_or%
  436.     ENDIF
  437.   ENDIF
  438.   '
  439.   ' * WANDERED INTO THUNDERSTORM?
  440.   IF PTST(SUB(acx%(ac%),2),ADD(acy%(ac%),2))=11
  441.     alert!=TRUE
  442.     INC collisions%
  443.     GOSUB reset_ac
  444.   ENDIF
  445.   '
  446.   ' * EXITING OR ENTERING AT FIX?
  447.   IF acx%(ac%)=85 AND acy%(ac%)=13    !PAST "DNV FIX?
  448.     GOSUB deactivate_ac(6,0,"DN",4)   !AT 6,000' and GOING NW and DNV FIX?
  449.   ENDIF
  450.   IF acx%(ac%)=145 AND acy%(ac%)=13   !PAST "OKC" FIX?
  451.     GOSUB deactivate_ac(6,6,"OK",2)   !AT 6,000' and GOING NE and OKC FIX?
  452.   ENDIF
  453.   IF acx%(ac%)=207 AND acy%(ac%)=93   !PAST "ADA" FIX?
  454.     GOSUB deactivate_ac(6,5,"AD",1)   !AT 6,000' and GOING E and ADA FIX?
  455.   ENDIF
  456.   IF acx%(ac%)=147 AND acy%(ac%)=185  !PAST "DFW" FIX?
  457.     GOSUB deactivate_ac(6,4,"DF",0)   !AT 6,000' and GOING SE and DFW FIX?
  458.   ENDIF
  459.   IF acx%(ac%)=83 AND acy%(ac%)=185   !PAST "LUB" FIX?
  460.     GOSUB deactivate_ac(6,2,"LU",6)   !AT 6,000' and GOING SW and LUB FIX?
  461.   ENDIF
  462.   IF acx%(ac%)=23 AND acy%(ac%)=61    !PAST "AMR" FIX?
  463.     GOSUB deactivate_ac(6,0,"AM",4)   !AT 6,000' and GOING NW and AMR FIX?
  464.   ENDIF
  465.   '
  466.   ' * AT 0' AND OVER AN AIRFIELD?
  467.   IF BTST(ca|(ac%),0) AND acx%(ac%)=115 !AT 0' FOR LANDING?
  468.     SELECT acy%(ac%)
  469.     CASE 73                     !OVER FORT SILL?
  470.       GOSUB over_airfield("FS")
  471.     CASE 113                    !OVER LAWTON MUNI?
  472.       GOSUB over_airfield("LA")
  473.     ENDSELECT
  474.   ENDIF
  475.   '
  476.   ' * OVER VOR?
  477.   IF acx%(ac%)=115 AND acy%(ac%)=43   !AT VOR1 FIX?
  478.     IF BTST(vor|(ac%),1)              !ORDERED TO HOLD AT VOR1?
  479.       vor|(ac%)=BSET(vor|(ac%),0)     !ACTIVATE HOLD BIT
  480.       SELECT ch|(ac%)
  481.       CASE 1 TO 8                     !HEADING S,SW,W,or NW?
  482.         vor|(ac%)=BSET(vor|(ac%),4)   !TURN LEFT AT VOR
  483.       CASE 16 TO 128                  !HEADING N,NE,E, or SE?
  484.         vor|(ac%)=BSET(vor|(ac%),3)   !TURN RIGHT AT VOR
  485.       ENDSELECT
  486.     ENDIF
  487.   ENDIF
  488.   IF acx%(ac%)=115 AND acy%(ac%)=153  !AT VOR2 FIX?
  489.     IF BTST(vor|(ac%),2)              !ORDERED TO HOLD AT VOR2?
  490.       vor|(ac%)=BSET(vor|(ac%),0)     !ACTIVATE HOLD BIT
  491.       SELECT ch|(ac%)
  492.       CASE 1 TO 8                     !HEADING S,SW,W,or NW?
  493.         vor|(ac%)=BSET(vor|(ac%),3)   !TURN LEFT AT VOR
  494.       CASE 16 TO 128                  !HEADING N,NE,E, or SE?
  495.         vor|(ac%)=BSET(vor|(ac%),4)   !TURN RIGHT AT VOR
  496.       ENDSELECT
  497.     ENDIF
  498.   ENDIF
  499. RETURN
  500. '
  501. ' *** DEACTIVATE AIRCRAFT, MAKE ROOM FOR ANOTHER AIRCRAFT ON LIST ***
  502. '
  503. PROCEDURE deactivate_ac(alt%,dir%,fix$,arv%)
  504.   IF BTST(ch|(ac%),arv%)  !arv%=ARRIVAL DIRECTION
  505.     GOTO new_arrival
  506.   ENDIF
  507.   IF BTST(ca|(ac%),alt%) AND BTST(ch|(ac%),dir%) AND MID$(arvdest$(ac%),4,2)=fix$
  508.     '  !PLANE EXITING AT 6,000' and PROPER HEADING and AT CORRECT FIX?
  509.     INC hand_off%         !SUCCESSFUL HAND OFF
  510.     GOSUB reset_ac
  511.   ELSE
  512.     alert!=TRUE
  513.     INC err_or%           !HANDOFF IN ERROR DUE TO WRONG ALT, DIR, or FIX
  514.     GOSUB reset_ac
  515.   ENDIF
  516. new_arrival:
  517. RETURN
  518. '
  519. ' *** PLANE OVER AIRPORT ***
  520. '
  521. PROCEDURE over_airfield(af$)
  522.   IF MID$(arvdest$(ac%),1,2)=af$    !JUST TAKING OFF FROM AIRFIELD?
  523.     GOTO pop_over_airfield
  524.   ENDIF
  525.   IF MID$(arvdest$(ac%),4,2)=af$    !DESTINATION CORRECT AIRFIELD?
  526.     GOSUB landed                    !GOING LANDING DIRECTION?
  527.   ELSE                              !DESTINATION REALLY OTHER AIRFIELD?
  528.     da|(ac%)=0                      !CLEAR BYTE
  529.     da|(ac%)=BSET(da|(ac%),1)       !TOUCH AND GO, CLIMB BACK TO 1,000'
  530.   ENDIF
  531. pop_over_airfield:
  532. RETURN
  533. '
  534. ' *** PLANE LANDED ***
  535. '
  536. PROCEDURE landed
  537.   IF BTST(ch|(ac%),land_dir%) !CORRECT HEADING FOR LANDING?
  538.     INC landed%               !SUCCESSFUL LANDING
  539.     GOSUB reset_ac
  540.   ELSE                        !LANDED WRONG DIRECTION, PLANE CRASHED
  541.     alert!=TRUE
  542.     INC err_or%
  543.     GOSUB reset_ac
  544.   ENDIF
  545. RETURN
  546. '
  547. ' *** RESET AIRCRAFT ***
  548. '
  549. PROCEDURE reset_ac
  550.   mc|(ac%)=0             !CLEAR MOVEMENT COUNTER BYTE
  551.   sp|(ac%)=0             !CLEAR SPEED COUNTER
  552.   vor|(ac%)=0            !CLEAR VOR BYTE
  553.   vor$(ac%)=" "          !NO 'v' ON RADAR ICON
  554.   lr|(ac%)=bit7|         !CLEAR LR BYTE, SET LEFT ON
  555.   ca|(ac%)=bit7|         !SET ALTITUDE 7,000'
  556.   da|(ac%)=bit7|
  557.   ch|(ac%)=bit7|         !SET HEADING NORTH
  558.   dh|(ac%)=bit7|
  559.   trafname$(ac%)="     " !CLEAR TRAFFIC LIST
  560.   arvdest$(ac%)="     "
  561.   acx%(ac%)=280          !PARK PLANE
  562.   acy%(ac%)=190
  563. RETURN
  564. '
  565. ' *** NEAR MISS AND COLLISION DETECTION
  566. '
  567. PROCEDURE near_miss
  568.   j%=1
  569.   FOR i%=1 TO 12
  570.     IF BTST(lr|(i%),1)   !AIRCRAFT IS ACTIVE INFLIGHT
  571.       x%(j%)=acx%(i%)    !BUILD TEMP ARRAY OF X,Y COORD AND ALTITUDES
  572.       y%(j%)=acy%(i%)    !OF ONLY INFLIGHT AIRCRAFT
  573.       a|(j%)=ca|(i%)
  574.       id|(j%)=i%         !***TEMP ARRAY OF INFLIGHT AIRCRAFT ID#
  575.       INC j%
  576.     ENDIF
  577.   NEXT i%
  578.   FOR i%=1 TO SUB(j%,1)   !CHECK ALL COMBINATIONS OF DISTANCES
  579.     k%=ADD(i%,1)          !BETWEEN INFLIGHT AIRCRAFT
  580.     DO UNTIL k%=ADD(j%,1)
  581.       VOID @nearmiss(x%(i%),x%(k%),y%(i%),y%(k%),a|(i%),a|(k%))
  582.       INC k%
  583.     LOOP
  584.   NEXT i%
  585.   ARRAYFILL x%(),0        !CLEAR TEMPORARY ARRAYS FOR NEXT NEARMISS CHECK
  586.   ARRAYFILL y%(),0
  587.   ARRAYFILL a|(),0
  588.   ARRAYFILL id|(),0
  589. RETURN
  590. '
  591. ' *** CHECK AIRCRAFT SEPARATION - SAME ALTITUDE? LESS THAN 3 MILES? ***
  592. '
  593. FUNCTION nearmiss(x1%,x2%,y1%,y2%,alt1|,alt2|)
  594.   IF alt1|=alt2|  !AIRCRAFT AT SAME ALTITUDE?
  595.     IF ADD(MUL(SUB(x1%,x2%),SUB(x1%,x2%)),MUL(SUB(y1%,y2%),SUB(y1%,y2%)))<899
  596.       ' !CHECK HYPOTENUSE OF TRIAGLE BETWEEN AIRCRAFT 1 and AIRCRAFT 2 COORD
  597.       alert!=TRUE
  598.       INC conflict%
  599.       VOID @collision(x1%,x2%,y1%,y2%)
  600.     ENDIF
  601.   ENDIF
  602.   RETURN alert!
  603. ENDFUNC
  604. '
  605. ' *** CHECK AIRCRAFT SEPARATION - COLLISION? ***
  606. '
  607. FUNCTION collision(x1%,x2%,y1%,y2%)
  608.   IF x1%=x2% AND y1%=y2%
  609.     collision!=TRUE
  610.     ac%=id|(i%)
  611.     GOSUB reset_ac      !REMOVE FIRST CRASHED PLANE FROM SCREEN
  612.     ac%=id|(k%)
  613.     GOSUB reset_ac      !REMOVE SECOND CRASHED PLANE FROM SCREEN
  614.     INC collisions%
  615.   ENDIF
  616.   RETURN collision!
  617. ENDFUNC
  618. '
  619. ' ******* HANDLE CLICKS ********
  620. '
  621. ' *** MOUSE BUTTON CLICK HANDLER ***
  622. '
  623. PROCEDURE click_handler
  624.   SELECT MENU(10)            !MOUSEX
  625.   CASE 4 TO 40
  626.     GOSUB pause_exit
  627.   CASE 278 TO 315
  628.     GOSUB select_aircraft
  629.   CASE 199 TO 270
  630.     GOSUB get_commands
  631.   ENDSELECT
  632. RETURN
  633. '
  634. ' *** PAUSE OR EXIT GAME ***
  635. '
  636. PROCEDURE pause_exit
  637.   SELECT MENU(11)           !WHERE IS MOUSE Y COORDINATE
  638.   CASE 14 TO 24             !PAUSE BUTTON CLICKED
  639.     PUT 3,14,pause_off$,3
  640.     m$="  Select PAUSE event  |  | Review Score Card or |  Study Radar Screen  "
  641.     ALERT 2,m$,2,"SCORE|RADAR",b%
  642.     IF b%=1
  643.       GOSUB score_card
  644.     ELSE
  645.       DO
  646.       LOOP UNTIL MOUSEK=1 !WAIT FOR LEFT MOUSE CLICK TO EXIT STUDY RADAR SCREEN
  647.       elapsed_time%=TIMER
  648.     ENDIF
  649.   CASE 188 TO 199           !EXIT BUTTON CLICKED
  650.     GOSUB all_done
  651.   ENDSELECT
  652. RETURN
  653. '
  654. ' *** EXIT GAME ***
  655. '
  656. PROCEDURE all_done
  657.   PUT 4,188,exit_off$,3
  658.   PAUSE 10
  659.   GOSUB restor_palette
  660. RETURN
  661. '
  662. ' *** SELECT AIRCRAFT ***
  663. '
  664. PROCEDURE select_aircraft
  665.   IF MENU(11)>16 AND MENU(11)<195        !CLICKED WHICH OF 12 AIRCRAFT?
  666.     oldsac%=sac%
  667.     sac%=ADD(SUB(MENU(11),16) DIV 15,1)  !AIRCRAFT# FOR COMMANDS UNTIL CHANGED
  668.     IF ASC(MID$(trafname$(sac%),2,1))>33 !SOME TYPE OF AIRCRAFT IS ON LIST
  669.       MID$(trafname$(oldsac%),1,1)=" "   !ERASE * AT PREVIOUS AIRCRAFT
  670.       MID$(trafname$(sac%),1,1)="*"      !MOVE * TO SELECTED AIRCRAFT
  671.     ELSE                                 !ERROR TRAP, LIST EMPTY
  672.       sac%=oldsac%                       !RESET PREVIOUSLY SELECTED AIRCRAFT
  673.       CLR oldsac%
  674.     ENDIF
  675.   ENDIF
  676. RETURN
  677. '
  678. ' *** GET COMMANDS ***
  679. '
  680. PROCEDURE get_commands
  681.   IF MID$(trafname$(sac%),1,1)="*"   !IS TRAFFIC SELECTED FIRST?
  682.     SELECT MENU(11)
  683.     CASE 16 TO 26
  684.       GOSUB clearance
  685.     CASE 50 TO 75
  686.       GOSUB vor
  687.     CASE 98 TO 107
  688.       GOSUB alt_1_3
  689.     CASE 108 TO 117
  690.       GOSUB alt_4_6
  691.     CASE 140 TO 154
  692.       GOSUB left_right
  693.     CASE 159 TO 194
  694.       GOSUB compass_rose
  695.     ENDSELECT
  696.   ENDIF
  697. RETURN
  698. '
  699. ' *** TAKEOFF/LAND ***
  700. '
  701. PROCEDURE clearance
  702.   SELECT MENU(10)
  703.   CASE 200 TO 238                      !TAKEOFF COMMAND
  704.     IF BTST(lr|(sac%),1)=0             !PLANE NOT INFLIGHT?
  705.       PUT 200,16,takeoff_off$,3        !BUTTON PRESS EFFECT
  706.       lr|(sac%)=BSET(lr|(sac%),1)      !SET INFLIGHT BIT 'ON'
  707.       ch|(sac%)=0                      !CLEAR CURRENT HEADING BYTE
  708.       ch|(sac%)=BSET(ch|(sac%),takeoff_dir%) !SET HEADING TAKEOFF DIRECTION
  709.       dh|(sac%)=0                      !CLEAR DESIRED HEADING BYTE
  710.       dh|(sac%)=BSET(dh|(sac%),takeoff_dir%)
  711.       ca|(sac%)=0                      !CLEAR CURRENT ALTITUDE BYTE
  712.       ca|(sac%)=BSET(ca|(sac%),0)      !SET ALTITUDE 0'
  713.       da|(sac%)=0                      !CLEAR DESIRED ALTITUDE BYTE
  714.       da|(sac%)=BSET(da|(sac%),1)      !SET DESIRED INITIAL ALTITUDE 1,000'
  715.       IF MID$(arvdest$(sac%),1,2)="FS"
  716.         acx%(sac%)=entryx%(7)          !SET TAKEOFF X,Y POSITION
  717.         acy%(sac%)=entryy%(7)
  718.       ELSE IF MID$(arvdest$(sac%),1,2)="LA"
  719.         acx%(sac%)=entryx%(8)          !SET TAKEOFF X,Y POSITION
  720.         acy%(sac%)=entryy%(8)
  721.       ENDIF
  722.     ENDIF
  723.   CASE 243 TO 267                      !LAND COMMAND
  724.     IF BTST(lr|(sac%),1)               !IS AIRCRAFT FLYING?
  725.       PUT 243,16,land_off$,3           !BUTTON PRESS EFFECT
  726.       da|(sac%)=0                      !CLEAR DESIRED ALTITUDE BYTE
  727.       da|(sac%)=BSET(da|(sac%),0)      !SET DESIRED ALTITUDE TO 0'
  728.     ENDIF
  729.   ENDSELECT
  730. RETURN
  731. '
  732. ' *** VOR1/VOR2 CLICKED ***
  733. '
  734. PROCEDURE vor
  735.   IF MENU(10)>238 AND MENU(10)<266
  736.     IF MENU(11)<62
  737.       PUT 238,51,vor1_off$,3  !VOR 1 CLICKED
  738.       PAUSE 8                 !VOR BUTTON TOO SENSITIVE
  739.       GOSUB vor_hold(1)
  740.     ELSE
  741.       PUT 238,64,vor2_off$,3  !VOR 2 CLICKED
  742.       PAUSE 8                 !VOR BUTTON TOO SENSITIVE
  743.       GOSUB vor_hold(2)
  744.     ENDIF
  745.   ENDIF
  746. RETURN
  747. '
  748. ' *** VOR HOLD TOGGLE ***
  749. '
  750. PROCEDURE vor_hold(vor%)
  751.   IF BTST(vor|(sac%),vor%)           !TOGGLE VOR1 or VOR2 HOLD BIT
  752.     vor|(sac%)=0                     !VOR HOLD OFF
  753.     vor$(sac%)=" "                   !REMOVE VOR MARKER FROM RADAR SCREEN
  754.   ELSE
  755.     vor|(sac%)=BSET(vor|(sac%),vor%) !VOR HOLD ON, AWAIT ARRIVAL VOR1 or VOR2
  756.     vor$(sac%)="v"                   !MARK AIRCRAFT WITH VOR MARKER
  757.     vor|(sac%)=BCLR(vor|(sac%),0)    !VOR NOT ACTIVE UNTIL AIRCRAFT GETS THERE
  758.   ENDIF
  759. RETURN
  760. '
  761. ' *** ALTITUDE 1,000 - 3,000 ***
  762. '
  763. PROCEDURE alt_1_3
  764.   SELECT MENU(10)
  765.   CASE 235 TO 246            !ALTITUDE 1,000 COMMAND
  766.     da|(sac%)=0
  767.     da|(sac%)=BSET(da|(sac%),1)
  768.     PUT 236,98,alt1_off$,3
  769.   CASE 247 TO 258            !ALTITUDE 2,000 COMMAND
  770.     da|(sac%)=0
  771.     da|(sac%)=BSET(da|(sac%),2)
  772.     PUT 247,98,alt2_off$,3
  773.   CASE 259 TO 270            !ALTITUDE 3,000 COMMAND
  774.     da|(sac%)=0
  775.     da|(sac%)=BSET(da|(sac%),3)
  776.     PUT 259,98,alt3_off$,3
  777.   ENDSELECT
  778. RETURN
  779. '
  780. ' *** ALTITUDE 4,000 - 7,000 ***
  781. '
  782. PROCEDURE alt_4_6
  783.   SELECT MENU(10)
  784.   CASE 235 TO 246            !ALTITUDE 4,000 COMMAND
  785.     da|(sac%)=0
  786.     da|(sac%)=BSET(da|(sac%),4)
  787.     PUT 236,108,alt4_off$,3
  788.   CASE 247 TO 258            !ALTITUDE 5,000 COMMAND
  789.     da|(sac%)=0
  790.     da|(sac%)=BSET(da|(sac%),5)
  791.     PUT 247,108,alt5_off$,3
  792.   CASE 259 TO 270            !ALTITUDE 6,000 COMMAND
  793.     da|(sac%)=0
  794.     da|(sac%)=BSET(da|(sac%),6)
  795.     PUT 259,108,alt6_off$,3
  796.   ENDSELECT
  797. RETURN
  798. '
  799. ' *** LEFT/RIGHT ***
  800. '
  801. PROCEDURE left_right
  802.   SELECT MENU(10)
  803.   CASE 233 TO 250                !LEFT TURN COMMAND
  804.     PUT 233,140,left_off$,3
  805.     lr|(sac%)=BSET(lr|(sac%),7)  !LEFT TURN BIT ON
  806.     lr|(sac%)=BCLR(lr|(sac%),6)  !RIGHT TURN BIT OFF
  807.   CASE 251 TO 268                !RIGHT TURN COMMAND
  808.     PUT 252,140,right_off$,3
  809.     lr|(sac%)=BSET(lr|(sac%),6)  !RIGHT TURN BIT ON
  810.     lr|(sac%)=BCLR(lr|(sac%),7)  !LEFT TURN BIT OFF
  811.   ENDSELECT
  812. RETURN
  813. '
  814. ' *** COMPASS ROSE ***
  815. '
  816. PROCEDURE compass_rose
  817.   SELECT MENU(11)
  818.   CASE 159 TO 164
  819.     dh|(sac%)=0
  820.     dh|(sac%)=BSET(dh|(sac%),7)    !NORTH HEADING COMMAND
  821.     PUT 222,158,head360_off$,3
  822.   CASE 165 TO 171
  823.     SELECT MENU(10)
  824.     CASE 208 TO 226
  825.       dh|(sac%)=0
  826.       dh|(sac%)=BSET(dh|(sac%),0)  !NORTHWEST HEADING COMMAND
  827.       PUT 206,165,head315_off$,3
  828.     CASE 240 TO 260
  829.       dh|(sac%)=0
  830.       dh|(sac%)=BSET(dh|(sac%),6)  !NORTHEAST HEADING COMMAND
  831.       PUT 238,165,head045_off$,3
  832.     ENDSELECT
  833.   CASE 172 TO 180
  834.     SELECT MENU(10)
  835.     CASE 199 TO 218
  836.       dh|(sac%)=0
  837.       dh|(sac%)=BSET(dh|(sac%),1)  !WEST HEADING COMMAND
  838.       PUT 198,173,head270_off$,3
  839.     CASE 248 TO 266
  840.       dh|(sac%)=0
  841.       dh|(sac%)=BSET(dh|(sac%),5)  !EAST HEADING COMMAND
  842.       PUT 246,173,head090_off$,3
  843.     ENDSELECT
  844.   CASE 181 TO 187
  845.     SELECT MENU(10)
  846.     CASE 208 TO 226
  847.       dh|(sac%)=0
  848.       dh|(sac%)=BSET(dh|(sac%),2)  !SOUTHWEST HEADING COMMAND
  849.       PUT 206,181,head225_off$,3
  850.     CASE 240 TO 260
  851.       dh|(sac%)=0
  852.       dh|(sac%)=BSET(dh|(sac%),4)  !SOUTHEAST HEADING COMMAND
  853.       PUT 238,181,head135_off$,3
  854.     ENDSELECT
  855.   CASE 188 TO 194
  856.     dh|(sac%)=0
  857.     dh|(sac%)=BSET(dh|(sac%),3)    !SOUTH HEADING COMMAND
  858.     PUT 222,188,head180_off$,3
  859.   ENDSELECT
  860. RETURN
  861. '
  862. ' ************************************************
  863. ' *** INITIALIZATION ROUTINES AND TITLE SCREEN ***
  864. ' ************************************************
  865. '
  866. ' *** DIM, FILL ARRAYS, SETUP SCREENS, ASSEMBLER SOURCE CODES ***
  867. '
  868. PROCEDURE inits
  869.   GOSUB get_rez_dir
  870.   DIM sav_pal%(15),blank_pal%(15),fade%(8),fadec%(8)
  871.   DIM lr|(12),sp|(12),mc|(12),ch|(12),dh|(12),ca|(12),da|(12),vor|(12)
  872.   DIM acx%(12),acy%(12),heading$(8)
  873.   DIM ac$(36),ad$(36),trafname$(12),arvdest$(12),vor$(12)
  874.   DIM trafnamey%(12),arvdesty%(12)
  875.   DIM entryx%(8),entryy%(8)
  876.   DIM x%(12),y%(12),a|(12),id|(12)
  877.   DIM storm_adr%(16),tsx%(2),tsy%(2)
  878.   HIDEM
  879.   DEFMOUSE 3
  880.   GOSUB sav_palette
  881.   GOSUB blank_screen
  882.   ON MENU BUTTON 1,1,1 GOSUB click_handler
  883.   physbase%=XBIOS(2)
  884.   logbase%=XBIOS(3)
  885.   RESERVE -256000                   !GIVE ME SOME ROOM
  886.   mem1%=MALLOC(32512)               !ALLOCATE MEMORY FOR SCREENS
  887.   mem2%=MALLOC(32512)
  888.   mem3%=MALLOC(32512)
  889.   mem4%=MALLOC(32512)
  890.   mem5%=MALLOC(32512)
  891.   mem6%=MALLOC(256)                 !ALLOCATE MEMORY FOR ASSEMBLER ROUTINES
  892.   mem7%=MALLOC(256)
  893.   mem8%=MALLOC(512)
  894.   mem9%=MALLOC(256)
  895.   mem10%=MALLOC(256)
  896.   mem11%=MALLOC(19200)                    !animation frames
  897.   titlescr_adr%=mem1%+256 AND &HFFFF00    !adjust screens to 256K boundary
  898.   logbase1_adr%=mem2%+256 AND &HFFFF00
  899.   logbase2_adr%=mem3%+256 AND &HFFFF00
  900.   grid_adr%=mem4%+256 AND &HFFFF00        !grid picture
  901.   overlay_adr%=mem5%+256 AND &HFFFF00     !overlay picture
  902.   asmmove1_adr%=mem6%                     !assembler subroutines
  903.   asmmove2_adr%=mem7%
  904.   asmput_adr%=mem8%
  905.   asmtxt_adr%=mem9%
  906.   which_bit%=mem10%
  907.   storm_scr_adr%=mem11%                   !STORM animation frames
  908.   title_song$=SPACE$(1500)
  909.   title_song_adr%=V:title_song$
  910.   '
  911.   EVERY 300 GOSUB red_off
  912.   GOSUB play_title_song
  913.   GOSUB title_screen
  914.   GOSUB other_inits
  915.   GOSUB load_grid_screen
  916.   GOSUB load_overlay_screen
  917.   GOSUB load_make_puts
  918.   GOSUB setup_asm
  919.   GOSUB fade_in
  920.   '
  921.   ' *** BYTE DEFINITIONS
  922.   '
  923.   ' CH byte = CURRENT HEADING    DH byte = DESIRED HEADING
  924.   '    Bit 7 = 360 degrees, North
  925.   '    Bit 6 = 045 degrees, Northeast
  926.   '    Bit 5 = 090 degrees, East
  927.   '    Bit 4 = 135 degrees, Southeast
  928.   '    Bit 3 = 180 degrees, South
  929.   '    Bit 2 = 225 degrees, Southwest
  930.   '    Bit 1 = 270 degrees, West
  931.   '    Bit 0 = 315 degrees, Northwest
  932.   '
  933.   '
  934.   ' CA byte = CURRENT ALTITUDE   DA byte = DESIRED ALTITUDE
  935.   '    Bit 7 = 7,000 feet AGL
  936.   '    Bit 6 = 6,000 Feet AGL
  937.   '    Bit 5 = 5,000 Feet AGL
  938.   '    Bit 4 = 4,000 Feet AGL
  939.   '    Bit 3 = 3,000 Feet AGL
  940.   '    Bit 2 = 2,000 Feet AGL
  941.   '    Bit 1 = 1,000 Feet AGL
  942.   '    Bit 0 =     0 Feet AGL
  943.   '
  944.   ' LR byte = LEFT or RIGHT TURN, SPEED, ACTIVITY
  945.   '    Bit 7 = Left
  946.   '    Bit 6 = Right
  947.   '    Bit 5 = Unused
  948.   '    Bit 4 = Speed 090 knots UH-1H
  949.   '    Bit 3 = Speed 120 knots T-37
  950.   '    Bit 2 = Speed 180 knots F-15E
  951.   '    Bit 1 = OFF(0)=Awaiting takeoff  ON(1)=Inflight  on radar screen
  952.   '    Bit 0 = OFF(0)=Inactive          ON(1)=Active    on traffic list
  953.   '
  954.   ' VOR byte = VOR1 or VOR2 STATUS
  955.   '    Bit 5-7 = Unused
  956.   '    Bit 4 = Right turn at VOR
  957.   '    Bit 3 = Left turn at VOR
  958.   '    Bit 2 = VOR2
  959.   '    Bit 1 = VOR1
  960.   '    Bit 0 = ON(1)=HOLD ACTIVATED
  961.   '
  962.   ' SP byte = SPEED COUNTER
  963.   '    Bit 5-7 = Unused
  964.   '    Bit 4 = 090 knots UH-1H
  965.   '    Bit 3 = 120 knots T-37
  966.   '    Bit 2 = 180 knots F-15E
  967.   '    Bit 1 = Reset Speed Counter
  968.   '    Bit 0 = Unused
  969.   '
  970.   ' MC byte = MOVEMENT NUMBER COUNTER
  971.   '    Bits 6-7 Unused
  972.   '    Bit 5 = Movement #5
  973.   '    Bit 4 = Movement #4
  974.   '    Bit 3 = Movement #3
  975.   '    Bit 2 = Movement #2
  976.   '    Bit 1 = Movement #1
  977.   '    BIT 0 = Unused
  978.   '
  979.   ' *** END BYTE DEFINITIONS
  980.   ' *******
  981.   ' ASSEMBLER SUBROUTINE WRITTEN BY JERRY BETHEL (DELPHI: BETHEL)-Public Domain
  982.   '
  983.   ' *** ASSEMBLER CHECK WHICH BIT IS SET IN BYTE ***
  984.   '
  985.   '           move.w  4(sp),d1
  986.   '           moveq.l    #7,d0
  987.   '   loop:   btst       d0,d1
  988.   '           dbne       d0,loop
  989.   '           rts
  990.   ' *******
  991.   ' ASSEMBLER SUBROUTINE WRITTEN BY JERRY BETHEL (DELPHI: BETHEL)-Public Domain
  992.   '
  993.   ' *** ASSEMBLER MOVE RASTER #1 IN MODE 3 ***
  994.   '
  995.   '   move.l 4(sp),a0  !move source and destination addresses to stack
  996.   '   move.l 8(sp),a1
  997.   '   addq.l #6,a0     !ignore 3 word PUT$ header
  998.   '   move.w #799,d0   !use d0 as counter
  999.   '  loop1:
  1000.   '   move.l (a0)+,(a1)+   !Move long words from source to destination
  1001.   '   move.l (a0)+,(a1)+   !ten at a time
  1002.   '   move.l (a0)+,(a1)+   !for total 8,000 words or 32,000 bytes
  1003.   '   move.l (a0)+,(a1)+
  1004.   '   move.l (a0)+,(a1)+
  1005.   '   move.l (a0)+,(a1)+
  1006.   '   move.l (a0)+,(a1)+
  1007.   '   move.l (a0)+,(a1)+
  1008.   '   move.l (a0)+,(a1)+
  1009.   '   move.l (a0)+,(a1)+
  1010.   '   dbf    d0,loop1  !decrement counter and brach to loop until d0=FALSE
  1011.   '   rts
  1012.   '
  1013.   ' *******
  1014.   ' ASSEMBLER SUBROUTINE WRITTEN BY JERRY BETHEL (DELPHI: BETHEL)-Public Domain
  1015.   '
  1016.   ' *** ASSEMBLER MOVE RASTER #2 IN MODE 6 ***
  1017.   '   move.l 4(sp),a0
  1018.   '   move.l 8(sp),a1
  1019.   '   addq.l #6,a0
  1020.   '   move.w #7999,d0
  1021.   '  loop1:
  1022.   '   move.l (a0)+,d1
  1023.   '   eor.l  d1,(a1)+
  1024.   '   dbf    d0,loop1
  1025.   '   rts
  1026.   '
  1027.   ' *******
  1028.   ' ASSEMBLER SUBROUTINE WRITTEN BY JERRY BETHEL (DELPHI: BETHEL)-Public Domain
  1029.   '
  1030.   ' *** ASSEMBLER TEXT COMMAND, SLIGHTLY FASTER ***
  1031.   '
  1032.   '      bra      main
  1033.   '   contrl:     ds.l 1
  1034.   '   intin:      ds.l 1
  1035.   '   ptsin:      ds.l 1
  1036.   '   intout:     ds.l 1
  1037.   '   ptsout:     ds.l 1
  1038.   '   main:
  1039.   '     move.l    contrl,a0
  1040.   '     move.w    #8,0(a0)      ;opcode
  1041.   '     move.w    #1,2(a0)      ;points in ptsin
  1042.   '     move.w    #2,12(a0)     ;workstation handle
  1043.   '     move.l    4(sp),a1
  1044.   '     move.w    4(a1),d1      ;# of characters
  1045.   '     move.w    d1,6(a0)
  1046.   '     move.l    ptsin,a0
  1047.   '     move.l    8(sp),(a0)    ;x and y coordinates
  1048.   '     move.l    (a1),a1       ;text pointer
  1049.   '     clr.w     d0
  1050.   '     move.l    intin,a0
  1051.   '   loop:
  1052.   '     move.b    (a1+),d0
  1053.   '     move.w    d0,(a0)+
  1054.   '     dbf       d1,loop
  1055.   '     move.w    #$73,d0
  1056.   '     lea       contrl,a0
  1057.   '     move.l    a0,d1
  1058.   '     trap      #2
  1059.   '     rts
  1060.   '
  1061.   ' *******
  1062.   ' ASSEMBLER SUBROUTINE USED WITH PERMISSION BY KINETIC MICROSYSTEMS
  1063.   ' FROM THE ANIMATIC-ANIMATION SYSTEM PROGRAM
  1064.   '
  1065.   ' *** ASSEMBLER PUT RASTER (STORM SEQUENCE) in MODE ***
  1066.   ' ; put_image(screen_base, image_buffer, x, y, width, height)
  1067.   ' ; int   *screen_base, *image_buffer, x, y, width, height, mode
  1068.   ' ;   Draws the retangular region stored in the image buffer to the
  1069.   ' ; screen at the specified co-ordinates. t
  1070.   ' put_image:
  1071.   '   movem.l D0-D7/A0-A2, -(A7)  ; Save registers on the stack
  1072.   '   ; This subtracts 44 bytes from A7
  1073.   '   ; (the stack grows down)
  1074.   '   ; Get the parameters passed to us.
  1075.   '   ; These are pushed on the stack in reverse
  1076.   '   ; order of their appearance in the function call
  1077.   '   ; The first longword on the stack is the return address
  1078.   '   move.l 48(A7), A0           ; Get screen base in A0
  1079.   '   move.l 52(A7), A1           ; Get image buffer in A1
  1080.   '   move.w  56(A7), D5          ; Get x co-ord
  1081.   '   move.w  58(A7), D6          ; Get y co-ord
  1082.   '   move.w  60(A7), D7          ; Get width
  1083.   '   move.w  62(A7), D4          ; Get height
  1084.   '                               ; The "mode" parameter is at 64(A7)
  1085.   '   muls #160, D6               ; 160 bytes of screen memory per scanline
  1086.   '   add.l  D6, A0               ; Add y offset to screen RAM pointer
  1087.   '   and.w   #$FFF0, D5          ; Round x co-ord to nearest 16
  1088.   '   asr.w   #1, D5              ; 1 byte per 2 pixels
  1089.   '   add.l  D5, A0               ; Add x offset to screen RAM pointer
  1090.   '   move.l A0, A2               ; Save a copy of pointer for later use
  1091.   '   move.w  56(A7), D5          ; Get x co-ord again
  1092.   '   move.w  D5, D6              ; And again
  1093.   '   and.w   #$FFF0, D5          ; Round x down to nearest 16
  1094.   '   sub.w   D5, D6              ; D6 = D6 - D5
  1095.   '   moveq   #16, D5
  1096.   '   sub.w   D6, D5              ; D5 = 16 - D5  (This is our shift count)
  1097.   '   ; We calculate three masks to save time later
  1098.   '   ; These are stored on the stack
  1099.   '   move.l  #$0000FFFF, D0      ; Mask 1
  1100.   '   lsl.l   D5, D0              ; Shift mask 1
  1101.   '   not.l   D0                  ; Take logical complement
  1102.   '   move.l  D0, -(A7)           ; Store mask 1 on the stack
  1103.   '   move.w  D7, D1              ; Get a copy of width in D1
  1104.   '   subq.w  #1, D1              ; width - 1
  1105.   '   and.w   #$FFF0, D1          ; Round D1 down to nearest 16
  1106.   '   add.w   #16, D1             ; Add 16 (we have effectively rounded
  1107.   '    ; up to the nearest 16)
  1108.   '   move.w  D7, D2              ; Get a copy of width in D2
  1109.   '   sub.w   D2, D1              ; D1 = D1 - D2
  1110.   '   ; Mask 2 is used to mask off bits past
  1111.   '   ; the end of the rectangle we're affecting
  1112.   '   move.l  #$0000FFFF, D0      ; Mask 2
  1113.   '   lsl.w   D1, D0              ; Shift the mask
  1114.   '   move.w  D0, -(A7)           ; Put mask 2 on the stack
  1115.   '   ; Mask 3
  1116.   '   lsl.l   D5, D0              ; Shift mask 2
  1117.   '   not.l   D0                  ; Take the logical complement
  1118.   '   move.l  D0, -(A7)           ; Put mask 3 on the stack
  1119.   '   ; NOTE:
  1120.   '   ;    Pushing the masks on the stack has
  1121.   '   ; decremented the stack pointer by 10.
  1122.   '   subq.w  #1, D4              ; Subtract one from height; our loop
  1123.   '   ; decrement instruction dbf goes to
  1124.   '   ; to -1, not zero.
  1125.   '   next_y:
  1126.   '   move.w  70(A7), D6          ; Get a copy of width
  1127.   '   subq.w  #1, D6              ; A width of 16 should give 1 word, not 2
  1128.   '   asr.w   #4, D6              ; D6 = D6 / 16
  1129.   '   cmp.w   #0, D6              ; D6 = 0 ?
  1130.   '   beq     trailer             ; yes; only one word -- it's the trailer
  1131.   '   ; no; do all words up to the trailer
  1132.   '   subq.w  #1, D6              ; dbf decrements to -1, not zero
  1133.   '   next_x:                     ; Get the next 16 pixels into the high
  1134.   '                               ; words of the registers.  We do this
  1135.   '                               ; by moving the data into the low words
  1136.   '                               ; and then swapping the register halves.
  1137.   '   moveq   #0, D0              ; Clear D0
  1138.   '   moveq   #0, D1              ; Clear D1
  1139.   '   moveq   #0, D2              ; Clear D2
  1140.   '   moveq   #0, D3              ; Clear D3
  1141.   '   move.w  (A1)+, D0           ; Get 1st bit plane into low word of D0
  1142.   '   move.w  (A1)+, D1           ; Get 2nd bit plane into low word of D1
  1143.   '   move.w  (A1)+, D2           ; Get 3rd bit plane into low word of D2
  1144.   '   move.w  (A1)+, D3           ; Get 4th bit plane into low word of D3
  1145.   '   lsl.l   D5, D0              ; Shift D0
  1146.   '   lsl.l   D5, D1              ; Shift D1
  1147.   '   lsl.l   D5, D2              ; Shift D2
  1148.   '   lsl.l   D5, D3              ; Shift D3
  1149.   '   moveq   #0, D7              ; Clear D7
  1150.   '   move.w  74(A7), D7          ; Get "mode" parameter
  1151.   '   cmp.w   #0, D7              ; mode = 0 ?
  1152.   '   beq     opaque              ; yes; this is an opaque copy
  1153.   '   ; no; this is a transparent copy
  1154.   '   move.l  D0, D7              ; or all 4 planes together:
  1155.   '   or.l    D1, D7              ;
  1156.   '   or.l    D2, D7              ;
  1157.   '   or.l    D3, D7              ;
  1158.   '   not.l   D7                  ; Take logical complement of D7
  1159.   '   opaque:
  1160.   '   or.l    6(A7), D7           ; or with mask 1
  1161.   '   addq.l  #8, A0              ; Point to low word of bit plane 1
  1162.   '   and.w   D7, (A0)            ; and plane 1 of screen RAM with mask
  1163.   '   or.w    D0, (A0)+           ; or plane 1 of data with screen RAM
  1164.   '   and.w   D7, (A0)            ; and plane 2 of screen RAM with mask
  1165.   '   or.w    D1, (A0)+           ; or plane 2 of data with screen RAM
  1166.   '   and.w   D7, (A0)            ; and plane 3 of screen RAM with mask
  1167.   '   or.w    D2, (A0)+           ; or plane 3 of data with screen RAM
  1168.   '   and.w   D7, (A0)            ; and plane 4 of screen RAM with mask
  1169.   '   or.w    D3, (A0)+           ; or plane 4 of data with screen RAM
  1170.   '   sub.l  #16, A0              ; Point to high word of bit plane 1
  1171.   '   swap    D0                  ; Swap register halves to get high word
  1172.   '   swap    D1                  ; Swap register halves to get high word
  1173.   '   swap    D2                  ; Swap register halves to get high word
  1174.   '   swap    D3                  ; Swap register halves to get high word
  1175.   '   swap    D7                  ; Swap register halves of mask too
  1176.   '   and.w   D7, (A0)            ; and plane 1 of screen RAM with mask
  1177.   '   or.w    D0, (A0)+           ; or plane 1 of data with screen RAM
  1178.   '   and.w   D7, (A0)            ; and plane 2 of screen RAM with mask
  1179.   '   or.w    D1, (A0)+           ; or plane 2 of data with screen RAM
  1180.   '   and.w   D7, (A0)            ; and plane 3 of screen RAM with mask
  1181.   '   or.w    D2, (A0)+           ; or plane 3 of data with screen RAM
  1182.   '   and.w   D7, (A0)            ; and plane 4 of screen RAM with mask
  1183.   '   or.w    D3, (A0)+           ; or plane 4 of data with screen RAM
  1184.   '   dbf     D6, next_x          ; Do the next 16 pixels
  1185.   '   trailer:                    ; The last word is special.
  1186.   '                               ; We need to mask off bits that fill out
  1187.   '                               ; the last word, but are past the end
  1188.   '                               ; of the rectangle we are affecting.
  1189.   '   moveq   #0, D0              ; Clear D0
  1190.   '   moveq   #0, D1              ; Clear D1
  1191.   '   moveq   #0, D2              ; Clear D2
  1192.   '   moveq   #0, D3              ; Clear D3
  1193.   '   move.w  (A1)+, D0           ; Get next word of image data (plane 1)
  1194.   '   move.w  (A1)+, D1           ; Get next word of image data (plane 2)
  1195.   '   move.w  (A1)+, D2           ; Get next word of image data (plane 3)
  1196.   '   move.w  (A1)+, D3           ; Get next word of image data (plane 4)
  1197.   '   move.w  4(A7), D7           ; Get a copy of mask 2
  1198.   '   and.w   D7, D0              ; and mask 2 with D0
  1199.   '   and.w   D7, D1              ; and mask 2 with D1
  1200.   '   and.w   D7, D2              ; and mask 2 with D2
  1201.   '   and.w   D7, D3              ; and mask 2 with D3
  1202.   '   lsl.l   D5, D0              ; Shift plane 1
  1203.   '   lsl.l   D5, D1              ; Shift plane 2
  1204.   '   lsl.l   D5, D2              ; Shift plane 3
  1205.   '   lsl.l   D5, D3              ; Shift plane 4
  1206.   '   moveq   #0, D7              ; Clear D7
  1207.   '   move.w  74(A7), D7          ; Get "mode" parameter
  1208.   '   cmp.w   #0, D7              ; mode = 0 ?
  1209.   '   beq     opaque2             ; yes; this is an opaque copy
  1210.   '   ; no; this is a transparent copy
  1211.   '   move.l  D0, D7              ; or all planes together:
  1212.   '   or.l    D1, D7              ;
  1213.   '   or.l    D2, D7              ;
  1214.   '   or.l    D3, D7              ;
  1215.   '   not.l   D7                  ; Take logical complement of D7
  1216.   '   opaque2:
  1217.   '   or.l    (A7), D7            ; or with mask 3
  1218.   '   addq.l  #8, A0              ; Point to low word of bit plane 1
  1219.   '   and.w   D7, (A0)            ; and plane 1 of screen RAM with mask
  1220.   '   or.w    D0, (A0)+           ; or plane 1 of data with screen RAM
  1221.   '   and.w   D7, (A0)            ; and plane 2 of screen RAM with mask
  1222.   '   or.w    D1, (A0)+           ; or plane 2 of data with screen RAM
  1223.   '   and.w   D7, (A0)            ; and plane 3 of screen RAM with mask
  1224.   '   or.w    D2, (A0)+           ; or plane 3 of data with screen RAM
  1225.   '   and.w   D7, (A0)            ; and plane 4 of screen RAM with mask
  1226.   '   or.w    D3, (A0)+           ; or plane 4 of data with screen RAM
  1227.   '   sub.l  #16, A0              ; Point to high word of bit plane 1
  1228.   '   swap    D0                  ; Swap register halves to get high word
  1229.   '   swap    D1                  ; Swap register halves to get high word
  1230.   '   swap    D2                  ; Swap register halves to get high word
  1231.   '   swap    D3                  ; Swap register halves to get high word
  1232.   '   swap    D7                  ; Swap register halves of mask too
  1233.   '   and.w   D7, (A0)            ; and plane 1 of screen RAM with mask
  1234.   '   or.w    D0, (A0)+           ; or plane 1 of data with screen RAM
  1235.   '   and.w   D7, (A0)            ; and plane 2 of screen RAM with mask
  1236.   '   or.w    D1, (A0)+           ; or plane 2 of data with screen RAM
  1237.   '   and.w   D7, (A0)            ; and plane 3 of screen RAM with mask
  1238.   '   or.w    D2, (A0)+           ; or plane 3 of data with screen RAM
  1239.   '   and.w   D7, (A0)            ; and plane 4 of screen RAM with mask
  1240.   '   or.w    D3, (A0)+           ; or plane 4 of data with screen RAM
  1241.   '   add.l  #160, A2             ; Point to start of image on next line
  1242.   '   move.l A2, A0
  1243.   '   dbf     D4, next_y          ; Do the next scan line
  1244.   '   add.l  #10, A7              ; Pop the three masks off the stack
  1245.   '   movem.l (A7)+, D0-D7/A0-A2  ; Restore registers from the stack
  1246.   '   rts                         ; Return
  1247.   '
  1248.   ' *** END ASSEMBLY SUBROUTINES
  1249. RETURN
  1250. '
  1251. ' *** START TITLE SONG PLAYING IN INTERRUPT WITH XBIOS CALL ***
  1252. '
  1253. PROCEDURE play_title_song
  1254.   i%=2
  1255.   RESTORE title_song_data
  1256.   GOSUB make_song_string
  1257.   RESTORE measure_1
  1258.   GOSUB make_song_string
  1259.   RESTORE measure_3
  1260.   GOSUB make_song_string
  1261.   RESTORE measure_6
  1262.   GOSUB make_song_string
  1263.   RESTORE measure_3
  1264.   GOSUB make_song_string
  1265.   RESTORE measure_7
  1266.   GOSUB make_song_string
  1267.   RESTORE measure_1
  1268.   GOSUB make_song_string
  1269.   RESTORE stop_song
  1270.   GOSUB make_song_string
  1271.   VOID XBIOS(32,L:title_song_adr%)
  1272. RETURN
  1273. '
  1274. ' *** MAKE TITLE SONG 'DOSOUND' STRING, "Beacon Beats by Kevin Mason" ***
  1275. '
  1276. PROCEDURE make_song_string
  1277.   DEC i%
  1278.   REPEAT
  1279.     READ a%
  1280.     MID$(title_song$,i%,1)=CHR$(a%)
  1281.     INC i%
  1282.   UNTIL a%=-1
  1283.   '
  1284. title_song_data:
  1285.   ' ! Register 6 and 7 = Enable Voices A-B, Noise Off
  1286.   ' ! Register 11 = Envelope Fine Period, followed by value
  1287.   ' ! Register 12 = Envelope Coarse Period, followed by value
  1288.   ' ! Register 13 = Envelope Shape, followed by value
  1289.   DATA 6,0
  1290.   DATA 7,&x11111100
  1291.   DATA 11,120
  1292.   DATA 12,80
  1293.   DATA 13,9
  1294.   ' ! Volume and Envelope Enable Voices A-B
  1295.   DATA 8,18
  1296.   DATA 9,0
  1297.   DATA 10,0
  1298.   DATA -1
  1299. measure_1:
  1300.   ' ! Register 0 = Fine Tune Voice A, followed by value
  1301.   ' ! Register 1 = Coarse Tune Voice A, followed by value
  1302.   ' ! Register 255 = Delay, followed by value 1 = 1/50 second (15 = 1/8th note)
  1303.   DATA 0,131,1,7,255,14
  1304.   DATA 8,0,255,1,8,18,13,9
  1305.   DATA 0,131,1,7,255,42
  1306.   DATA 8,0,255,1,8,18,13,9
  1307.   DATA 0,131,1,7,255,56
  1308.   DATA 8,0,255,1,8,18,13,9
  1309.   ' !Measure 2
  1310.   DATA 0,131,1,7,255,14
  1311.   DATA 8,0,255,1,8,18,13,9
  1312.   DATA 0,131,1,7,255,42
  1313.   DATA 8,0,255,1,8,18,13,9
  1314.   DATA 0,131,1,7,255,56
  1315.   DATA 8,0,255,1,8,18,13,9,9,13
  1316.   DATA -1
  1317. measure_3:
  1318.   ' ! Register 2 = Fine Tune Voice B, followed by value
  1319.   ' ! Register 3 = Coarse Tune Voice B, followed by value
  1320.   DATA 0,131,1,7,2,221,3,1,255,14
  1321.   DATA 8,0,255,1,8,18,13,9
  1322.   DATA 0,131,1,7,2,221,3,1,255,42
  1323.   DATA 8,0,255,1,8,18,13,9
  1324.   DATA 0,131,1,7,2,221,3,1,255,14
  1325.   DATA 9,0,255,1,9,13
  1326.   DATA 0,131,1,7,2,221,3,1,255,14
  1327.   DATA 9,0,255,1,9,13
  1328.   DATA 0,131,1,7,2,169,3,1,255,6
  1329.   DATA 9,0,255,1,9,13
  1330.   DATA 0,131,1,7,2,221,3,1,255,6
  1331.   DATA 9,0,255,1,9,13
  1332.   DATA 0,131,1,7,2,169,3,1,255,16
  1333.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1334.   ' !Measure 4
  1335.   DATA 0,131,1,7,2,123,3,1,255,14
  1336.   DATA 8,0,255,1,8,18,13,9
  1337.   DATA 0,131,1,7,2,123,3,1,255,42
  1338.   DATA 8,0,255,1,8,18,13,9
  1339.   DATA 0,131,1,7,2,123,3,1,255,14
  1340.   DATA 9,0,255,1,9,13
  1341.   DATA 0,131,1,7,2,123,3,1,255,14
  1342.   DATA 9,0,255,1,9,13
  1343.   DATA 0,131,1,7,2,102,3,1,255,6
  1344.   DATA 9,0,255,1,9,13
  1345.   DATA 0,131,1,7,2,123,3,1,255,6
  1346.   DATA 9,0,255,1,9,13
  1347.   DATA 0,131,1,7,2,102,3,1,255,16
  1348.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1349.   ' !Measure 5
  1350.   DATA 0,131,1,7,2,63,3,1,255,14
  1351.   DATA 8,0,255,1,8,18,13,9
  1352.   DATA 0,131,1,7,2,63,3,1,255,42
  1353.   DATA 8,0,255,1,8,18,13,9
  1354.   DATA 0,131,1,7,2,63,3,1,255,14
  1355.   DATA 9,0,255,1,9,13
  1356.   DATA 0,131,1,7,2,221,3,1,255,14
  1357.   DATA 9,0,255,1,9,13
  1358.   DATA 0,131,1,7,2,169,3,1,255,6
  1359.   DATA 9,0,255,1,9,13
  1360.   DATA 0,131,1,7,2,221,3,1,255,6
  1361.   DATA 9,0,255,1,9,13
  1362.   DATA 0,131,1,7,2,169,3,1,255,16
  1363.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1364.   DATA -1
  1365. measure_6:
  1366.   DATA 0,131,1,7,2,221,3,1,255,14
  1367.   DATA 8,0,255,1,8,18,13,9
  1368.   DATA 0,131,1,7,2,221,3,1,255,42
  1369.   DATA 8,0,255,1,8,18,13,9
  1370.   DATA 0,131,1,7,2,221,3,1,255,56
  1371.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1372.   DATA -1
  1373. measure_7:
  1374.   DATA 0,131,1,7,2,221,3,1,255,14
  1375.   DATA 8,0,255,1,8,18,13,9
  1376.   DATA 0,131,1,7,2,221,3,1,255,42
  1377.   DATA 8,0,255,1,8,18,13,9
  1378.   DATA 0,131,1,7,2,221,3,1,255,14
  1379.   DATA 9,0,255,1,9,0
  1380.   DATA 0,131,1,7,255,14
  1381.   DATA 9,0,255,1,9,13
  1382.   DATA 0,131,1,7,2,250,3,1,255,28
  1383.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1384.   ' !Measure 8
  1385.   DATA 0,157,1,5,2,56,3,2,255,14
  1386.   DATA 8,0,255,1,8,18,13,9
  1387.   DATA 0,157,1,5,2,56,3,2,255,28
  1388.   DATA 9,0,255,1,9,13
  1389.   DATA 0,157,1,5,2,221,3,1,255,14
  1390.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1391.   DATA 0,157,1,5,2,221,3,1,255,28
  1392.   DATA 9,0,255,1,9,13
  1393.   DATA 0,157,1,5,2,56,3,2,255,28
  1394.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1395.   ' !Measure 9
  1396.   DATA 0,131,1,7,2,126,3,2,255,14
  1397.   DATA 8,0,255,1,8,18,13,9
  1398.   DATA 0,131,1,7,2,126,3,2,255,28
  1399.   DATA 9,0,255,1,9,13
  1400.   DATA 0,131,1,7,2,221,3,1,255,14
  1401.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1402.   DATA 0,131,1,7,2,221,3,1,255,28
  1403.   DATA 9,0,255,1,9,13
  1404.   DATA 0,131,1,7,2,169,3,1,255,28
  1405.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1406.   ' !Measure 10
  1407.   DATA 0,131,1,7,2,123,3,1,255,14
  1408.   DATA 8,0,255,1,8,18,13,9
  1409.   DATA 0,131,1,7,2,123,3,1,255,42
  1410.   DATA 8,0,255,1,8,18,13,9
  1411.   DATA 0,131,1,7,2,123,3,1,255,14
  1412.   DATA 9,0,255,1,9,13
  1413.   DATA 0,131,1,7,2,221,3,1,255,14
  1414.   DATA 9,0,255,1,9,13
  1415.   DATA 0,131,1,7,2,169,3,1,255,6
  1416.   DATA 9,0,255,1,9,13
  1417.   DATA 0,131,1,7,2,221,3,1,255,6
  1418.   DATA 9,0,255,1,9,13
  1419.   DATA 0,131,1,7,2,169,3,1,255,16
  1420.   DATA 8,0,9,0,255,1,8,18,13,9,9,13
  1421.   ' !Measure 11
  1422.   DATA 0,131,1,7,2,221,3,1,255,14
  1423.   DATA 8,0,255,1,8,18,13,9
  1424.   DATA 0,131,1,7,2,221,3,1,255,42
  1425.   DATA 8,0,255,1,8,18,13,9
  1426.   DATA 0,131,1,7,2,221,3,1,255,42
  1427.   DATA 9,0,255,1
  1428.   DATA 0,131,1,7,2,221,3,1,255,14
  1429.   DATA 8,0,255,1,8,18,13,9
  1430.   DATA -1
  1431. stop_song:
  1432.   DATA 7,255,8,0,9,0,10,0
  1433.   DATA 255,0
  1434.   DATA -1
  1435. RETURN
  1436. '
  1437. ' *** LOAD AND SHOW TITLE SCREEN ***
  1438. '
  1439. PROCEDURE title_screen
  1440.   temp$=SPACE$(32066)
  1441.   temp_adr%=V:temp$
  1442.   BLOAD path$+"tower.pi1",temp_adr%                !LOAD TITLE SCREEN
  1443.   tcolr$=MID$(temp$,3,32)
  1444.   tcolr_adr%=V:tcolr$
  1445.   VOID XBIOS(6,L:tcolr_adr%)                       !TITLE SCREEN COLORS
  1446.   BMOVE temp_adr%+34,titlescr_adr%,32000
  1447.   GOSUB setup_fade_in
  1448.   VOID XBIOS(5,L:titlescr_adr%,L:titlescr_adr%,-1) !SHOW TITLE SCREEN
  1449.   CLR temp$
  1450.   GOSUB white_on
  1451. RETURN
  1452. '
  1453. ' *** SET UP BLINKING LIGHTS AND FADE-IN ***
  1454. '
  1455. PROCEDURE setup_fade_in
  1456.   white_light%=CARD{tcolr_adr%+2}
  1457.   green_light%=CARD{tcolr_adr%+4}
  1458.   red_light%=CARD{tcolr_adr%+6}
  1459.   fade%(0)=CARD{tcolr_adr%}
  1460.   fade%(1)=CARD{tcolr_adr%+18}
  1461.   fade%(2)=CARD{tcolr_adr%+14}
  1462.   fade%(3)=CARD{tcolr_adr%+20}
  1463.   fade%(4)=CARD{tcolr_adr%+22}
  1464.   fade%(5)=CARD{tcolr_adr%+24}
  1465.   fade%(6)=CARD{tcolr_adr%+26}
  1466.   fade%(7)=CARD{tcolr_adr%+28}
  1467.   fade%(8)=CARD{tcolr_adr%+16}
  1468.   fadec%(1)=9
  1469.   fadec%(2)=7
  1470.   fadec%(3)=10
  1471.   fadec%(4)=11
  1472.   fadec%(5)=12
  1473.   fadec%(6)=13
  1474.   fadec%(7)=14
  1475.   fadec%(8)=8
  1476.   FOR i%=7 TO 14
  1477.     VOID XBIOS(7,i%,fade%(0))                 !TURN OFF ALL COLORS EXCEPT LIGHTS
  1478.   NEXT i%
  1479.   VOID XBIOS(7,2,fade%(0))                    !GREEN TOWER BEACON OFF
  1480.   black$=STRING$(32,CHR$(0))                  !SET UP BLACK SCREEN
  1481.   black_adr%=V:black$
  1482. RETURN
  1483. '
  1484. ' *** RED OFF / RED ON ***
  1485. '
  1486. PROCEDURE red_off
  1487.   VOID XBIOS(7,3,fade%(0))
  1488.   PAUSE 20
  1489.   VOID XBIOS(7,3,red_light%)     !RESET RED ON
  1490. RETURN
  1491. '
  1492. ' *** GREEN BEACON ON ***
  1493. '
  1494. PROCEDURE green_on
  1495.   VOID XBIOS(7,2,green_light%)
  1496.   PAUSE 24
  1497.   VOID XBIOS(7,2,fade%(0))
  1498. RETURN
  1499. '
  1500. ' *** WHITE-WHITE BEACON (MILITARY AIRPORT SIGNAL) ***
  1501. '
  1502. PROCEDURE white_on
  1503.   VOID XBIOS(7,2,white_light%)
  1504.   PAUSE 10
  1505.   VOID XBIOS(7,2,fade%(0))
  1506.   PAUSE 4
  1507.   VOID XBIOS(7,2,white_light%)
  1508.   PAUSE 10
  1509.   VOID XBIOS(7,2,fade%(0))
  1510. RETURN
  1511. '
  1512. ' *** OTHER INITS ***
  1513. '
  1514. PROCEDURE other_inits
  1515.   bit7|=&X10000000
  1516.   ARRAYFILL mc|(),0           !MOVEMENT NUMBER COUNTER
  1517.   ARRAYFILL sp|(),0           !SPEED COUNTER
  1518.   ARRAYFILL lr|(),bit7|       !LEFT, RIGHT, SPEED, ACTIVITY
  1519.   ARRAYFILL ch|(),bit7|       !CURRENT HEADING - INIT North, 360 Degrees
  1520.   ARRAYFILL dh|(),bit7|       !DESIRED HEADING - INIT North, 360 Degrees
  1521.   ARRAYFILL ca|(),bit7|       !CURRENT ALTITUDE- INIT 7,000 feet
  1522.   ARRAYFILL da|(),bit7|       !DESIRED ALTITUDE- INIT 7,000 feet
  1523.   ARRAYFILL vor|(),0          !VOR - INIT HOLD OFF
  1524.   ARRAYFILL acx%(),290        !AIRCRAFT X POSITION
  1525.   ARRAYFILL acy%(),190        !AIRCRAFT Y POSITION
  1526.   ARRAYFILL x%(),0            !TEMPORARY ARRAYS FOR NEARMISS/COLLISION, X POS
  1527.   ARRAYFILL y%(),0            !Y POS
  1528.   ARRAYFILL a|(),0            !ALTITUDE
  1529.   ARRAYFILL id|(),0           !AIRCRAFT ID#
  1530.   temp$="     "
  1531.   FOR i%=1 TO 12
  1532.     trafname$(i%)=temp$ !TRAFFIC LIST
  1533.     arvdest$(i%)=temp$
  1534.     vor$(i%)=" "
  1535.     j%=ADD(16,MUL(i%,15))
  1536.     trafnamey%(i%)=SUB(j%,9)
  1537.     arvdesty%(i%)=SUB(j%,3)
  1538.   NEXT i%
  1539.   CLR temp$
  1540.   entryx%(1)=85      !ENTRY FIX (X) DENVER (DNV)
  1541.   entryy%(1)=13       !ENTRY FIX (Y) DENVER
  1542.   entryx%(2)=145     !              OKLAHOMA CITY (OKC)
  1543.   entryy%(2)=13
  1544.   entryx%(3)=225     !              ADA (ADA)
  1545.   entryy%(3)=93
  1546.   entryx%(4)=145     !              DALLAS-FORT WORTH (DFW)
  1547.   entryy%(4)=183
  1548.   entryx%(5)=85      !              LUBBOCK (LUB)
  1549.   entryy%(5)=183
  1550.   entryx%(6)=15      !              AMARILLO (AMR)
  1551.   entryy%(6)=53
  1552.   entryx%(7)=115     !              FORT SILL (HENRY POST) AIRFIELD (FSI)
  1553.   entryy%(7)=73
  1554.   entryx%(8)=115     !              LAWTON MUNICIPAL AIRPORT (LAW)
  1555.   entryy%(8)=113
  1556.   tsx%(1)=10         !INITIAL X,Y COORDINATES OF TWO THUNDERSTORM CLOUDS
  1557.   tsy%(1)=106
  1558.   tsx%(2)=38
  1559.   tsy%(2)=126
  1560.   nb%=1              !NORTH BOUNDARY
  1561.   eb%=230            !EAST BOUNDARY
  1562.   sb%=198            !SOUTH BOUNDARY
  1563.   wb%=1              !WEST BOUNDARY
  1564.   counter%=0
  1565.   heading$(7)=" N"   !RADAR TARGET PRINTOUT FOR HEADING,
  1566.   heading$(6)="NE"   !CORRESPOND WITH CURRENT HEADING BYTE
  1567.   heading$(5)=" E"
  1568.   heading$(4)="SE"
  1569.   heading$(3)=" S"
  1570.   heading$(2)="SW"
  1571.   heading$(1)=" W"
  1572.   heading$(0)="NW"
  1573.   point$="/"
  1574.   total_ac%=37  !ACTUALLY ONLY 36, BUT RANDOM(37)=#FROM 0 TO 36
  1575.   ac_count%=0   !KEEP COUNT OF NUMBER OF AIRCRAFT HANDLED
  1576.   ac%=1
  1577.   sac%=1        !SELECTED AIRCRAFT #1
  1578.   hand_off%=0   !# SUCCESSFUL HAND OFFS TO OTHER CONTROLLERS
  1579.   landed%=0     !# SUCCESFUL LANDINGS
  1580.   err_or%=0     !# ERRORS, WRONG EXITS, OUT OF BOUNDS, LANDED WRONG DIRECTION
  1581.   conflict%=0   !# SECONDS OF NEARMISS, SAME ALT-LESS THAN 3 MILES
  1582.   collisions%=0 !# COLLISIONS
  1583.   sm%=1         !STORM ANIMATION SEQUENCE IN TRANSPARENT MODE
  1584.   sf1%=16       !STORM CLOUD 1 FRAME NUMBER STARTS AS 16
  1585.   sf2%=16       !STORM CLOUD 2 FRAME NUMBER STARTS AS 16
  1586.   begin_storm%=RANDOM(40)+1  !STORM BEGIN ANYTIME IN FIRST 40 MINUTES
  1587.   storm_counter%=1
  1588.   change_course%=1
  1589.   start!=TRUE
  1590.   all_handled!=FALSE
  1591.   all_activated!=FALSE
  1592.   collision!=FALSE
  1593.   alert!=FALSE
  1594.   begin_storm!=FALSE
  1595.   storm!=FALSE
  1596.   storm_over!=FALSE
  1597.   GRAPHMODE 2
  1598.   DEFTEXT 11,0,0,4               !WHITE LETTERS, 6x6 FONT
  1599.   nl2#=LOG(2)
  1600.   PAUSE 200
  1601.   GOSUB green_on
  1602. RETURN
  1603. '
  1604. ' *** LOAD RADAR GRID SCREEN ***
  1605. '
  1606. PROCEDURE load_grid_screen
  1607.   OPEN "i",#1,path$+"gridmask.scr"
  1608.   BGET #1,grid_adr%,16003
  1609.   PAUSE 1        !LET RED LIGHT BLINK
  1610.   BGET #1,grid_adr%+16003,16003
  1611.   CLOSE #1
  1612.   GOSUB white_on
  1613. RETURN
  1614. '
  1615. ' *** LOAD RADAR CONTROLS OVERLAY SCREEN ***
  1616. '
  1617. PROCEDURE load_overlay_screen
  1618.   OPEN "i",#1,path$+"atccontl.scr"
  1619.   BGET #1,overlay_adr%,16003
  1620.   PAUSE 1        !LET RED LIGHT BLINK
  1621.   BGET #1,overlay_adr%+16003,16003
  1622.   CLOSE #1
  1623.   GOSUB green_on
  1624. RETURN
  1625. '
  1626. ' *** LOAD AND ASSEMBLE PUT STRINGS and COLOR SCREEN2 PALETTE ***
  1627. '
  1628. PROCEDURE load_make_puts
  1629.   GOSUB red_off
  1630.   '
  1631.   pmg$=SPACE$(3100)
  1632.   BLOAD path$+"sprites.scr",VARPTR(pmg$)
  1633.   '
  1634.   exit_off$=MID$(pmg$,1,270)
  1635.   pause_off$=MID$(pmg$,271,270)
  1636.   takeoff_off$=MID$(pmg$,541,270)
  1637.   land_off$=MID$(pmg$,811,182)
  1638.   vor1_off$=MID$(pmg$,993,182)
  1639.   vor2_off$=MID$(pmg$,1175,182)
  1640.   left_off$=MID$(pmg$,1357,126)
  1641.   right_off$=MID$(pmg$,1483,126)
  1642.   head045_off$=MID$(pmg$,1609,118)
  1643.   head090_off$=MID$(pmg$,1727,118)
  1644.   head135_off$=MID$(pmg$,1845,118)
  1645.   head180_off$=MID$(pmg$,1963,118)
  1646.   head225_off$=MID$(pmg$,2081,118)
  1647.   head270_off$=MID$(pmg$,2199,118)
  1648.   head315_off$=MID$(pmg$,2317,118)
  1649.   alt1_off$=MID$(pmg$,2435,78)
  1650.   alt2_off$=MID$(pmg$,2513,78)
  1651.   alt3_off$=MID$(pmg$,2591,78)
  1652.   alt4_off$=MID$(pmg$,2669,78)
  1653.   alt5_off$=MID$(pmg$,2747,78)
  1654.   alt6_off$=MID$(pmg$,2825,78)
  1655.   '
  1656.   colrscr2$=MID$(pmg$,2903,32)        !COLOR PALETTE RADAR CONSOLE
  1657.   colrscr2_adr%=VARPTR(colrscr2$)
  1658.   red%=DPEEK(colrscr2_adr%+4)
  1659.   mgray%=DPEEK(colrscr2_adr%+16)
  1660.   '
  1661.   alert_snd$=MID$(pmg$,2935,30)
  1662.   alert_snd_adr%=VARPTR(alert_snd$)
  1663.   '
  1664.   head360_off$=MID$(pmg$,2965,118)
  1665.   GOSUB white_on
  1666. RETURN
  1667. '
  1668. ' *** CREATE ASSEMBLER SUBROUTINES ***
  1669. '
  1670. PROCEDURE setup_asm
  1671.   RESTORE which_bit_routine
  1672.   FOR i%=0 TO 6
  1673.     READ a%
  1674.     CARD{which_bit%+(i%*2)}=a%
  1675.   NEXT i%
  1676.   '
  1677.   RESTORE asmroutine1
  1678.   FOR i%=0 TO 19
  1679.     READ a%
  1680.     CARD{asmmove1_adr%+(i%*2)}=a%
  1681.   NEXT i%
  1682.   '
  1683.   RESTORE asmroutine2
  1684.   FOR i%=0 TO 11
  1685.     READ a%
  1686.     CARD{asmmove2_adr%+(i%*2)}=a%
  1687.   NEXT i%
  1688.   '
  1689.   RESTORE asm_text_routine
  1690.   FOR i%=0 TO 47
  1691.     READ a%
  1692.     CARD{asmtxt_adr%+(i%*2)}=a%
  1693.   NEXT i%
  1694.   '
  1695.   RESTORE asmroutine3
  1696.   FOR i%=0 TO 183
  1697.     READ a%
  1698.     CARD{asmput_adr%+(i%*2)}=a%
  1699.   NEXT i%
  1700.   '
  1701.   GOSUB red_off
  1702.   PAUSE 150
  1703.   GOSUB green_on
  1704.   '
  1705. which_bit_routine:
  1706.   DATA 12847,4,28679,257,22216,65532,20085
  1707.   '
  1708. asmroutine1:
  1709.   DATA 8303,4,8815,8,23688,12348,799,8920
  1710.   DATA 8920,8920,8920,8920,8920,8920,8920,8920
  1711.   DATA 8920,20936,65514,20085
  1712.   '
  1713. asmroutine2:
  1714.   DATA 8303,4,8815,8,23688,12348,7999,8728
  1715.   DATA 45977,20936,65530,20085
  1716.   '
  1717. asm_text_routine:
  1718.   DATA 24576,22,0,0,0,0,0,0
  1719.   DATA 0,0,0,0,8314,65514,12668,8
  1720.   DATA 0,12668,1,2,12668,2,12,8815
  1721.   DATA 4,12841,4,12609,6,8314,65488,8367
  1722.   DATA 8,8785,16960,8314,65472,4121,12480,20937
  1723.   DATA 65530,12348,115,16890,65452,8712,20034,20085
  1724.   '
  1725. asmroutine3:
  1726.   DATA 18663,65504,8303,48,8815,52,14895,56
  1727.   DATA 15407,58,15919,60,14383,62,52732,160
  1728.   DATA 53702,51836,65520,57925,53701,9288,14895,56
  1729.   DATA 15365,51836,65520,40005,31248,39494,8252,0
  1730.   DATA 65535,60328,18048,12032,12807,21313,49788,65520
  1731.   DATA 53884,16,13319,37442,8252,0,65535,58216
  1732.   DATA 16128,60328,18048,12032,21316,15407,70,21318
  1733.   DATA 59462,48252,0,26368,110,21318,28672,29184
  1734.   DATA 29696,30208,12313,12825,13337,13849,60328,60329
  1735.   DATA 60330,60331,32256,15919,74,48764,0,26368
  1736.   DATA 12,11776,36481,36482,36483,18055,36527,6
  1737.   DATA 20616,53072,33112,53072,33624,53072,34136,53072
  1738.   DATA 34648,37372,0,16,18496,18497,18498,18499
  1739.   DATA 18503,53072,33112,53072,33624,53072,34136,53072
  1740.   DATA 34648,20942,65432,28672,29184,29696,30208,12313
  1741.   DATA 12825,13337,13849,15919,4,49223,49735,50247
  1742.   DATA 50759,60328,60329,60330,60331,32256,15919,74
  1743.   DATA 48764,0,26368,12,11776,36481,36482,36483
  1744.   DATA 18055,36503,20616,53072,33112,53072,33624,53072
  1745.   DATA 34136,53072,34648,37372,0,16,18496,18497
  1746.   DATA 18498,18499,18503,53072,33112,53072,33624,53072
  1747.   DATA 34136,53072,34648,54780,0,160,8266,20940
  1748.   DATA 65290,57340,0,10,19679,2047,20085,0
  1749. RETURN
  1750. '
  1751. ' *** FADE_IN TITLE SCREEN, SELECT TRAFFIC VOLUME ***
  1752. '
  1753. PROCEDURE fade_in
  1754.   FOR i%=1 TO 8
  1755.     VOID XBIOS(7,fadec%(i%),fade%(i%))
  1756.     PAUSE 1
  1757.   NEXT i%
  1758.   BLOAD path$+"storm.scr",storm_scr_adr%
  1759.   w%=CARD{storm_scr_adr%+40}              !WIDTH STORM ANIMATION FRAMES
  1760.   h%=CARD{storm_scr_adr%+42}              !HEIGHT STORM ANIMATION FRAMES
  1761.   storm_base_adr%=storm_scr_adr%+64       !SKIP 32 WORD HEADER
  1762.   FOR i%=0 TO 15
  1763.     storm_adr%(i%+1)=storm_base_adr%+(i%*1152) !ADDRESS EACH STORM FRAME
  1764.   NEXT i%
  1765.   GOSUB white_on
  1766.   GOSUB make_strings
  1767.   PAUSE 150
  1768.   GOSUB green_on
  1769.   PAUSE 10
  1770.   EVERY STOP
  1771.   mess$=" |   WHAT VOLUME OF TRAFFIC   |DO YOU WANT TO HANDLE TODAY?| "
  1772.   button$="STUDENT|ROOKIE|MASTER"
  1773.   SHOWM
  1774.   ALERT 2,mess$,2,button$,b%
  1775.   SELECT b%
  1776.   CASE 1                !ONE NEW PLANE ADDED EVERY 2.5 min +/- 36 sec
  1777.     game_speed%=150
  1778.     game_speed_var%=72
  1779.     points_var%=1000
  1780.     bonus%=2000
  1781.   CASE 2                !ONE NEW PLANE ADDED EVERY 1.5 min +/- 24 sec
  1782.     game_speed%=90
  1783.     game_speed_var%=48
  1784.     points_var%=2000
  1785.     bonus%=4000
  1786.   CASE 3                !ONE NEW PLANE ADDED EVERY 45 sec +/- 15 sec
  1787.     game_speed%=45
  1788.     game_speed_var%=30
  1789.     points_var%=4000
  1790.     bonus%=8000
  1791.   ENDSELECT
  1792.   mess$=" | WHAT LANDING AND  | TAKEOFF DIRECTION | DO YOU WANT TODAY? "
  1793.   button$="NORTH|SOUTH"
  1794.   ALERT 2,mess$,1,button$,b%
  1795.   HIDEM
  1796.   SELECT b%
  1797.   CASE 1
  1798.     land_dir%=7
  1799.     takeoff_dir%=7
  1800.   CASE 2
  1801.     land_dir%=3
  1802.     takeoff_dir%=3
  1803.   ENDSELECT
  1804.   CLR title_song$
  1805.   VOID XBIOS(6,L:black_adr%)
  1806.   '
  1807.   LONG{asmtxt_adr%+4}=CONTRL
  1808.   LONG{asmtxt_adr%+8}=INTIN
  1809.   LONG{asmtxt_adr%+12}=PTSIN
  1810.   LONG{asmtxt_adr%+16}=INTOUT
  1811.   LONG{asmtxt_adr%+20}=PTSOUT
  1812. RETURN
  1813. '
  1814. ' *** MAKE STRINGS TO IDENTIFY AIRCRAFT, ARRIVALS, DESTINATIONS ***
  1815. '
  1816. PROCEDURE make_strings
  1817.   ac$(0)=" F999"     !F=FIGHTER, JET, F-16, 180 Knots
  1818.   ac$(1)=" T249"     !T=TRAINER, JET, T-37, 120 Knots
  1819.   ac$(2)=" A638"     !A=ARMY, HELICOPTER, UH-1H, 090 Knots
  1820.   ac$(3)=" T155"
  1821.   ac$(4)=" F448"
  1822.   ac$(5)=" A071"
  1823.   ac$(6)=" T129"
  1824.   ac$(7)=" T774"
  1825.   ac$(8)=" A422"
  1826.   ac$(9)=" T150"
  1827.   ac$(10)=" F097"
  1828.   ac$(11)=" A814"
  1829.   ac$(12)=" T245"
  1830.   ac$(13)=" T515"
  1831.   ac$(14)=" A623"
  1832.   ac$(15)=" T997"
  1833.   ac$(16)=" F542"
  1834.   ac$(17)=" A151"
  1835.   ac$(18)=" T400"
  1836.   ac$(19)=" T842"
  1837.   ac$(20)=" A740"
  1838.   ac$(21)=" T484"
  1839.   ac$(22)=" F965"
  1840.   ac$(23)=" A357"
  1841.   ac$(24)=" T596"
  1842.   ac$(25)=" T917"
  1843.   ac$(26)=" A362"
  1844.   ac$(27)=" T763"
  1845.   ac$(28)=" F508"
  1846.   ac$(29)=" A896"
  1847.   ac$(30)=" T437"
  1848.   ac$(31)=" T674"
  1849.   ac$(32)=" A893"
  1850.   ac$(33)=" T668"
  1851.   ac$(34)=" F928"
  1852.   ac$(35)=" A458"
  1853.   ac$(36)=" T041"
  1854.   '
  1855.   RESTORE arrival_destinations
  1856.   FOR i%=0 TO 36
  1857.     READ ad$(i%)
  1858.   NEXT i%
  1859. arrival_destinations:
  1860.   DATA OK-LU,FS-DF,AD-AM,DN-AD,LA-AM,DF-OK
  1861.   DATA AM-LA,LU-FS,LA-DF,DN-FS,DF-LA,LA-OK
  1862.   DATA FS-AM,AD-LA,AM-DF,FS-AD,OK-LA,LU-OK
  1863.   DATA FS-OK,DN-DF,OK-FS,LA-DN,AM-FS,LU-DN
  1864.   DATA LA-LU,FS-DN,DN-LU,AM-AD,LA-AD,DF-DN
  1865.   DATA LU-LA,AD-FS,OK-DF,LU-AD,FS-LU,DF-FS
  1866.   DATA AD-LU
  1867. RETURN
  1868. '
  1869. ' *********************
  1870. ' *** HOUSE KEEPING ***
  1871. ' *********************
  1872. '
  1873. ' *** GET RESOLUTION, BETTER BE LOW REZ, AND GET DRIVE/PATHWAY ***
  1874. '
  1875. PROCEDURE get_rez_dir
  1876.   rez%=XBIOS(4)
  1877.   IF rez%>0
  1878.     mess$=" FINAL APPROACH |   CONTROLLER   | IN LOW REZ ONLY"
  1879.     ALERT 3,mess$,1,"DANG",b%
  1880.     QUIT
  1881.   ENDIF
  1882.   CLR rez%
  1883.   '
  1884.   path$=SPACE$(64)
  1885.   drive$=CHR$(GEMDOS(&H19)+65)            !GET DRIVE NAME (A-P)
  1886.   VOID GEMDOS(&H47,L:VARPTR(path$),0)!GET PATH NAME
  1887.   i%=1
  1888.   REPEAT
  1889.     EXIT IF MID$(path$,i%,1)=CHR$(0) !STRIP PATH NAME OF SPACES
  1890.     INC i%
  1891.   UNTIL i%>64
  1892.   path$=LEFT$(path$,i%-1)
  1893.   path$=drive$+":"+path$+"\"
  1894.   mess$=" must be in the same |  directory as APPROACH.GFA |    and GFABASRO.PRG."
  1895.   IF NOT EXIST(path$+"tower.pi1")
  1896.     ALERT 3,"TOWER.PI1"+mess$,1,"ABORT",d%
  1897.     END
  1898.   ENDIF
  1899.   IF NOT EXIST(path$+"GRIDMASK.SCR")
  1900.     ALERT 3,"GRIDMASK.SCR"+mess$,1,"ABORT",d%
  1901.     END
  1902.   ENDIF
  1903.   IF NOT EXIST(path$+"ATCCONTL.SCR")
  1904.     ALERT 3,"ATCCONTL.SCR"+mess$,1,"ABORT",d%
  1905.     END
  1906.   ENDIF
  1907.   IF NOT EXIST(path$+"SPRITES.SCR")
  1908.     ALERT 3,"SPRITES.SCR"+mess$,1,"ABORT",d%
  1909.     END
  1910.   ENDIF
  1911.   IF NOT EXIST(path$+"STORM.SCR")
  1912.     ALERT 3,"STORM.SCR"+mess$,1,"ABORT",d%
  1913.     END
  1914.   ENDIF
  1915. RETURN
  1916. '
  1917. ' *** SAVE DESKTOP COLOR PALETTE BEFORE PROGRAM STARTS ***
  1918. '
  1919. PROCEDURE sav_palette
  1920.   FOR i%=0 TO 15
  1921.     sav_pal%(i%)=XBIOS(7,i%,-1)
  1922.   NEXT i%
  1923. RETURN
  1924. '
  1925. ' *** BLANK SCREEN ***
  1926. '
  1927. PROCEDURE blank_screen
  1928.   FOR i%=0 TO 15
  1929.     blank_pal%(i%)=0
  1930.   NEXT i%
  1931.   blank_pal_adr%=V:blank_pal%(0)
  1932.   VOID XBIOS(6,L:blank_pal_adr%)
  1933. RETURN
  1934. '
  1935. ' *** RESTORE DESKTOP COLOR PALETTE AT PROGRAM COMPLETION ***
  1936. '
  1937. PROCEDURE restor_palette
  1938.   GOSUB score_card
  1939.   EVERY STOP
  1940.   FOR i%=0 TO 15
  1941.     VOID XBIOS(7,i%,sav_pal%(i%))
  1942.   NEXT i%
  1943.   SOUND 0,0,0,0
  1944.   WAVE 0,0,0,0,0
  1945.   ~MFREE(mem1%)
  1946.   ~MFREE(mem2%)
  1947.   ~MFREE(mem3%)
  1948.   ~MFREE(mem4%)
  1949.   ~MFREE(mem5%)
  1950.   ~MFREE(mem6%)
  1951.   ~MFREE(mem7%)
  1952.   ~MFREE(mem8%)
  1953.   ~MFREE(mem9%)
  1954.   ~MFREE(mem10%)
  1955.   ~MFREE(mem11%)
  1956.   RESERVE
  1957.   EDIT
  1958. RETURN
  1959. '
  1960. ' *** SCORE CARD ***
  1961. '
  1962. PROCEDURE score_card
  1963.   VOID XBIOS(5,L:logbase%,L:physbase%,-1)
  1964.   CLS
  1965.   GRAPHMODE 1
  1966.   DEFFILL 12,2,8
  1967.   PBOX 0,0,319,199
  1968.   DEFFILL 13,2,8
  1969.   PBOX 60,15,260,185
  1970.   GRAPHMODE 2
  1971.   DEFTEXT 0,0,0,13
  1972.   TEXT 75,35,"      SCORE CARD"
  1973.   DEFTEXT 8,0,0,13
  1974.   points%=landed%*points_var%
  1975.   TEXT 75,55,"Landed     = "+STR$(landed%)
  1976.   ADD points%,hand_off%*points_var%
  1977.   TEXT 75,75,"Handoffs   = "+STR$(hand_off%)
  1978.   SUB points%,err_or%*100
  1979.   TEXT 75,95,"Errors     = "+STR$(err_or%)
  1980.   SUB points%,conflict%*100
  1981.   TEXT 75,115,"Conflicts  = "+STR$(conflict%)
  1982.   TEXT 75,135,"Collisions = "+STR$(collisions%)
  1983.   IF err_or%>0 OR conflict%>0 OR collisions%>0
  1984.     bonus%=0
  1985.   ENDIF
  1986.   ADD points%,bonus%
  1987.   IF collisions%>0
  1988.     points%=0
  1989.   ENDIF
  1990.   IF landed%=0 AND hand_off%=0
  1991.     points%=0
  1992.   ENDIF
  1993.   TEXT 75,155,"TOTAL POINTS = "+STR$(points%)
  1994.   DEFTEXT 0,0,0,6
  1995.   TEXT 75,175,"  left click to exit"
  1996.   REPEAT
  1997.   UNTIL MOUSEK=1
  1998.   CLS
  1999.   DEFTEXT 0,0,0,4
  2000.   elapsed_time%=201
  2001. RETURN
  2002.